Download |
;
; This file provides some simplification of the expressions produced by
; the derivative system.
;
; ** Main simplifier **
; This just calls a single simplifier for each of sum and product, but
; sends some parameters to adapt it. It also does an extra step for
; products which changes products containing 0 to 0.
(defun simplify (E)
(cond
((is-sum E) (simpl 'is-sum (lambda (x) (cons '+ x)) 0 E))
((is-product E)
(kill-zero (simpl 'is-product (lambda (x) (cons '* x)) 1 E)))
(t E)
)
)
; ** Zero killer
; If the argument is a product and contains zero, return zero. Else
; return the argument.
(defun kill-zero (E)
(cond
((not (is-product E)) E)
((null (remove-if (lambda (x) (not (equal 0 x))) E)) E)
(t 0)
)
)
; ** General simplifier
; This works for either sums or products. It takes the function which
; identifies sub-expressions of the same type, the function which adds the
; correct operator symbol to the front of the list, the identity for the
; operation, and the expression. It gets the parts (terms or factors),
; simplifies each one, flattens the list (which removes sublists of
; the same type, as (+ 5 (+ 6 7)) to + (+ 5 6 7)), removes the identity
; (which is 0 or 1), then does some cleanup and adds the operator symbol
; back to the list.
(defun simpl (is-same-type add-operator identity E)
(let*
(
(parts (cdr E))
(simparts (mapcar 'simplify parts))
(flatparts (flatten is-same-type simparts))
(id-dropped (remove-if (lambda (z) (equal identity z)) flatparts))
)
(proper add-operator identity id-dropped)
)
)
; Here is the code for flatten. It takes sublists of the same type and
; merges them into the whole list, as (* (* a b 2) 3 (* 5 2)) to
; (* a b 2 3 5 2)
(defun flatten (is-same items)
(cond
((null items) ())
((funcall is-same (car items))
(append (cdr (car items)) (flatten is-same (cdr items))) )
(t (cons (car items) (flatten is-same (cdr items))))
)
)
; A clean-up step to avoid stuff like (*) and (+ x). Its basic function is
; to add the operator back to the front of a list of simplified parts,
; but it checks and avoids producing expressions with zero or one part.
(defun proper (add-operator identity items)
(cond
((null items) identity)
((null (cdr items)) (car items))
(t (funcall add-operator items))
)
)