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))