Maxima: Testing of simplify()



Hi Ziga,

I have done some further testing of the two versions of simplify() that were 
posted, and the results seem encouraging.

For the examples below, the first version (simplifyv1.lisp) somehow produces 
shorter simplified expressions that the second version (simplifyv2.lisp).

Any assistance with further tuning  or improvements of the program would be 
appreciated.

Regards,

C. Frangos.


z = 2*(-sin(q2)*sin(q4)*sin(q6+q5)^2*sin(q8)
           +cos(q2)*cos(q4)*sin(q6+q5)^2*sin(q8)
           -sin(q2)*sin(q4)*cos(q6+q5)^2*sin(q8)
           +cos(q2)*cos(q4)*cos(q6+q5)^2*sin(q8)
           +cos(q2)*sin(q4)*sin(q6+q5)*cos(q8)
           +sin(q2)*cos(q4)*sin(q6+q5)*cos(q8))

/*simplifyv1.lisp results follow*/

zsimp = 2*cos(q4+q2)*sin(q8)+2*sin(q4+q2)*sin(q6+q5)*cos(q8)


/*simplifyv2.lisp results follow*/

zsimp = -(cos(q8+q6+q5+q4+q2)-cos(q8+q6+q5-q4-q2)-cos(q8-q6-q5+q4+q2)
                                  +cos(q8-q6-q5-q4-q2)-4*cos(q4+q2)*sin(q8))/2






z = cos(q4+q2)^2*sin(q6+q5)^2*sin(q8)^3+cos(q4+q2)*sin(q4+q2)*sin(q6+q5)
                                                  *cos(q8)*sin(q8)^2
                                       +cos(q4+q2)^2*sin(q6+q5)^2*cos(q8)
^2
                                                    *sin(q8)
                                       -cos(q4+q2)^2*cos(q6+q5)^2*sin(q8)
                                       +cos(q4+q2)*sin(q4+q2)*sin(q6+q5)
                                                  *cos(q8)^3


/*simplifyv1.lisp results follow*/

zsimp = cos(q4+q2)*sin(q4+q2)*sin(q6+q5)*cos(q8)
      -cos(q4+q2)^2*cos(2*(q6+q5))*sin(q8)



/*simplifyv2.lisp results follow*/

zsimp = cos(q4+q2)*(sin(q8)*(cos(q4+q2)*sin(q6+q5)^2*sin(q8)^2
                            +sin(q4+q2)*sin(q6+q5)*cos(q8)*sin(q8)
                            +cos(q4+q2)*sin(q6+q5)^2*cos(q8)^2
                            -cos(q4+q2)*cos(q6+q5)^2)
                   +sin(q4+q2)*sin(q6+q5)*cos(q8)^3)





-------------- next part --------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Simplify
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This library is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by the 
;;; Free Software Foundation; either version 2 of the License, or (at
;;; your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License along 
;;; with this library; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
;;; Copyright (C) 2009 Ziga Lenarcic
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun $cost (expr)
  (if (atom expr)
    1
    (1+ (apply #'+ (mapcar #'$cost (rest expr))))))

(defun hec (x)
  ($radcan ($trigreduce x)))
(defun hec2 (x)
  ($radcan ($demoivre x)))
(defun hec3 (x)
  (meval `(($trigsimp) ,x)))
(defparameter *simplify-functions*
  '(
  $factor
  $factorsum
  $expand
  $ratsimp
  $radcan
  $rectform
  $trigreduce
  hec3
  hec
  $rectform
  hec2
  $exponentialize))

(defun $simplify (expr &optional (cost-function #'$cost))
  (if (listp expr)
  (let ((best-expr expr)
        (best-cost (funcall cost-function expr)))
    (dolist (fun *simplify-functions*)
      (let* ((new-expr (funcall fun expr))
             (new-cost (funcall cost-function new-expr)))
        (if (< new-cost best-cost) (setf best-cost new-cost
                                         best-expr new-expr)
          (let* ((new-expr2 (funcall fun best-expr))
                 (new-cost2 (funcall cost-function new-expr2)))
            (when (< new-cost2 best-cost)
              (setf best-cost new-cost2
                    best-expr new-expr2))))
      ))

    (if (listp best-expr)
      (cons (first best-expr) (mapcar #'$simplify (rest best-expr)))
      best-expr)
    )
  expr))

-------------- next part --------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Simplify
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This library is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by the 
;;; Free Software Foundation; either version 2 of the License, or (at
;;; your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License along 
;;; with this library; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
;;; Copyright (C) 2009 Ziga Lenarcic
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun $leaf_count (expr)
  (cond ((atom expr) 1)
        ((eq (caar expr) 'mrat) ($leaf_count (ratdisrep expr)))
        (t (1+ (reduce #'+ (mapcar #'$leaf_count (rest expr)))))))

(defun hec (x)
  ($radcan ($trigreduce x)))
(defun hec2 (x)
  ($radcan ($demoivre x)))
(defun hec3 (x)
  (take '($trigsimp) x))
(defparameter *simplify-functions*
  '(
  $factor
  $factorsum
  $expand
  $ratsimp
  $radcan
  $rectform
  $trigreduce
  hec3
  hec
  $rectform
  hec2
  $exponentialize))

(defun $simplify (expr &optional (cost-function #'$leaf_count))
  (if (listp expr)
  (let ((best-expr expr)
        (best-cost (mfuncall cost-function expr)))
    (dolist (fun *simplify-functions*)
      (let* ((new-expr (funcall fun expr))
             (new-cost (mfuncall cost-function new-expr)))
        (if (< new-cost best-cost) (setf best-cost new-cost
                                         best-expr new-expr)
          (let* ((new-expr2 (funcall fun best-expr))
                 (new-cost2 (mfuncall cost-function new-expr2)))
            (when (< new-cost2 best-cost)
              (setf best-cost new-cost2
                    best-expr new-expr2))))
      ))

    (if (listp best-expr)
      (cons (first best-expr) (mapcar #'$simplify (rest best-expr)))
      best-expr)
    )
  expr))