Asp Forum - algebraic simplification

Taoufik Dachraoui

2/2/2016 7:21:00 PM

Hi

I found a small lisp program to simplify algebraic expressions
http://www.qrg.northwestern.edu/bps/cps/simp...
this inspired me to write a small algebraic simplification
using the pattern matching I wrote sometimes ago

defrule-std is used to define standard rules, and defrule extends the standard rules; the result of applying
all the rules is necessarily an expression that is accepted by standard rules.

? (make-rules algebra)
T
? (defrule-std algebra (+ ?x ?y) `(+ ,(apply-rules 'algebra x) ,(apply-rules 'algebra y)))
T
? (defrule-std algebra (+ ?x 0) (apply-rules 'algebra x))
T
? (defrule-std algebra (+ 0 ?x) (apply-rules 'algebra x))
T
? (defrule-std algebra (* ?x ?y) `(* ,(apply-rules 'algebra x) ,(apply-rules 'algebra y)))
T
? (defrule-std algebra (* _ 0) 0)
T
? (defrule-std algebra (* 0 _) 0)
T
? (defrule-std algebra (* ?x 1) (apply-rules 'algebra x))
T
? (defrule-std algebra (* 1 ?x) (apply-rules 'algebra x))
T
? (defrule algebra (+ ?x ?y . ?rest) `(+ ,x (+ ,y . ,rest)))
T
? (defrule algebra (+ ?x) x)
T
? (defrule algebra (* ?x ?y . ?rest) `(* ,x (* ,y . ,rest)))
T
? (defrule algebra (* ?x) x)
T
? (apply-rules 'algebra '(+ (* 1 (+ 2 0 3 0) (+ 4 (* (+ 0 2) (* 0 3) 5) 0)) 5))
(+ (* (+ 2 3) 4) 5)

Note: the defrule, unlike defrule-std, calls apply-rules on the result of the rule

Kind regards
Taoufik

2 Answers

Taoufik Dachraoui

2/2/2016 7:35:00 PM

Taoufik Dachraoui

2/2/2016 7:59:00 PM

On Tuesday, February 2, 2016 at 8:21:10 PM UTC+1, Taoufik Dachraoui wrote:
> Hi
>
> I found a small lisp program to simplify algebraic expressions
> http://www.qrg.northwestern.edu/bps/cps/simp...
> this inspired me to write a small algebraic simplification
> using the pattern matching I wrote sometimes ago
>
> defrule-std is used to define standard rules, and defrule extends the standard rules; the result of applying
> all the rules is necessarily an expression that is accepted by standard rules.
>
> ? (make-rules algebra)
> T
> ? (defrule-std algebra (+ ?x ?y) `(+ ,(apply-rules 'algebra x) ,(apply-rules 'algebra y)))
> T
> ? (defrule-std algebra (+ ?x 0) (apply-rules 'algebra x))
> T
> ? (defrule-std algebra (+ 0 ?x) (apply-rules 'algebra x))
> T
> ? (defrule-std algebra (* ?x ?y) `(* ,(apply-rules 'algebra x) ,(apply-rules 'algebra y)))
> T
> ? (defrule-std algebra (* _ 0) 0)
> T
> ? (defrule-std algebra (* 0 _) 0)
> T
> ? (defrule-std algebra (* ?x 1) (apply-rules 'algebra x))
> T
> ? (defrule-std algebra (* 1 ?x) (apply-rules 'algebra x))
> T
> ? (defrule algebra (+ ?x ?y . ?rest) `(+ ,x (+ ,y . ,rest)))
> T
> ? (defrule algebra (+ ?x) x)
> T
> ? (defrule algebra (* ?x ?y . ?rest) `(* ,x (* ,y . ,rest)))
> T
> ? (defrule algebra (* ?x) x)
> T
> ? (apply-rules 'algebra '(+ (* 1 (+ 2 0 3 0) (+ 4 (* (+ 0 2) (* 0 3) 5) 0)) 5))
> (+ (* (+ 2 3) 4) 5)
>
> Note: the defrule, unlike defrule-std, calls apply-rules on the result of the rule
>
> Kind regards
> Taoufik

I just wanted to make the algebraic a little more interesting (I included a function to do
function derivation):

(make-rules algebra)

(with-std-rules algebra
((+ ?x ?y) (if (and (numberp x) (numberp y))
(+ x y)
`(+ ,(apply-rules 'algebra x) ,(apply-rules 'algebra y))))
((+ ?x 0) (apply-rules 'algebra x))
((+ 0 ?x) (apply-rules 'algebra x))
((- ?x ?y) (if (and (numberp x) (numberp y))
(- x y)
`(- ,(apply-rules 'algebra x) ,(apply-rules 'algebra y))))
((- ?x 0) (apply-rules 'algebra x))
((- 0 ?x) `(- ,(apply-rules 'algebra x)))
((- ?x) `(- ,(apply-rules 'algebra x)))
((* ?x ?y) (if (and (numberp x) (numberp y))
(* x y)
`(* ,(apply-rules 'algebra x) ,(apply-rules 'algebra y))))
((* _ 0) 0)
((* 0 _) 0)
((* ?x 1) (apply-rules 'algebra x))
((* 1 ?x) (apply-rules 'algebra x))
((/ ?x ?y) (if (and (numberp x) (numberp y))
(/ x y)
`(/ ,(apply-rules 'algebra x) ,(apply-rules 'algebra y))))
((/ _ 0) (error "division by zero in expression"))
((/ 0 _) 0)
((/ ?x 1) (apply-rules 'algebra x))
((/ !x !x) 1)
((expt ?x ?y) (if (and (numberp x) (numberp y))
(expt x y)
`(expt ,(apply-rules 'algebra x) ,(apply-rules 'algebra y))))
((expt _ 0) 1)
((expt 1 _) 1)
((expt 0 _) 0)
((expt ?x 1) x)
((exp ?x) (if (numberp x) (exp x) `(exp ,(apply-rules 'algebra x))))
((sqrt ?x) (if (numberp x) (sqrt x) `(sqrt ,(apply-rules 'algebra x))))
((log ?x) (if (numberp x) (log x) `(log ,(apply-rules 'algebra x))))
((log ?x ?y) (if (and (numberp x) (numberp y))
(log x y)
`(log ,(apply-rules 'algebra x) ,(apply-rules 'algebra y))))
((sin ?x) (if (numberp x) (sin x) `(sin ,(apply-rules 'algebra x))))
((cos ?x) (if (numberp x) (cos x) `(cos ,(apply-rules 'algebra x))))
((asin ?x) (if (numberp x) (asin x) `(asin ,(apply-rules 'algebra x))))
((acos ?x) (if (numberp x) (acos x) `(acos ,(apply-rules 'algebra x))))
((tan ?x) (if (numberp x) (tan x) `(tan ,(apply-rules 'algebra x))))
((atan ?x) (if (numberp x) (atan x) `(atan ,(apply-rules 'algebra x)))))

(with-rules algebra
((+ ?x ?y . ?rest) `(+ ,x (+ ,y . ,rest)))
((+ ?x) x)
((- ?x ?y . ?rest) `(- ,x (+ ,y . ,rest)))
((* ?x ?y . ?rest) `(* ,x (* ,y . ,rest)))
((* ?x) x)
((/ ?x ?y . ?rest) `(/ ,x (/ ,y . ,rest)))
((/ ?x) `(/ 1 ,x)))

(defun deriv (expr var)
(apply-rules 'algebra
(let ((r
(match (apply-rules 'algebra expr)
((expt ?f (:and (:type number) ?n)) `(* (expt ,f (- ,n 1)) (* ,(deriv f var) ,n))) ; should be in simplify
((expt ?f ?g) `(* (expt ,f ,g) (+ (* ,(deriv f var) (/ ,g ,f)) (* ,(deriv g var) (log ,f)))))
((exp ?g) `(* (exp ,g) ,(deriv g var)))
((log ?f) `(/ ,(deriv f var) ,f))
((log ?f ?n) (deriv `(/ (log ,f) (log ,n)) var))
((sqrt ?g) (deriv `(expt ,g 1/2) var))
((sin ?g) `(* (cos ,g) ,(deriv g var)))
((cos ?g) `(* (- (sin ,g)) ,(deriv g var)))
((tan ?g) `(* (+ 1 (expt (tan ,g) 2)) ,(deriv g var)))
((asin ?g) `(* (/ 1 (sqrt (- 1 (expt ,g 2)))) ,(deriv g var)))
((acos ?g) `(* (- (/ 1 (sqrt (- 1 (expt ,g 2))))) ,(deriv g var)))
((atan ?g) `(* (/ 1 (+ 1 (expt ,g 2))) ,(deriv g var)))
((sinh ?g) `(* (/ (+ (exp ,g) (exp (- ,g))) 2) ,(deriv g var)))
((cosh ?g) `(* (/ (- (exp ,g) (exp (- ,g))) 2) ,(deriv g var)))
((+ ?f ?g) `(+ ,(deriv f var) ,(deriv g var)))
((- ?f ?g) `(- ,(deriv f var) ,(deriv g var)))
((* ?f ?g) `(+ (* ,f ,(deriv g var)) (* ,g ,(deriv f var))))
((/ ?f ?g) `(/ (- (* ,(deriv f var) ,g) (* ,(deriv g var) ,f)) (expt ,g 2)))
((- ?f) `(- ,(deriv f var)))
;((?f ?g) `(* (,(deriv f var) ,g) ,(deriv g var)))
(?x (if (eq x var) 1 0))
(_ 0))))
;(print r)
r)))

(deriv '(+ (expt u 6)
(* 2 (expt u 3))
(expt x 12)
(* 2 (expt x 7))
(* 2 (expt x 6) (expt y 5))
(* 3 (expt x 6))
(* 6 (expt x 3) (expt z 4))
(* 2 (expt x 2) (expt z 4))
(* 2 x (expt y 5))
(* 2 x)
(expt y 10)
(expt y 8)
(* 2 (expt y 5))
(* 10 (expt z 8))
2) 'x)

? (deriv '(+ (expt u 6)
(* 2 (expt u 3))
(expt x 12)
(* 2 (expt x 7))
(* 2 (expt x 6) (expt y 5))
(* 3 (expt x 6))
(* 6 (expt x 3) (expt z 4))
(* 2 (expt x 2) (expt z 4))
(* 2 x (expt y 5))
(* 2 x)
(expt y 10)
(expt y 8)
(* 2 (expt y 5))
(* 10 (expt z 8))
2) 'x)
(+ (* (EXPT X 11) 12)
(+ (* 2 (* (EXPT X 6) 7))
(+ (* 2 (* (EXPT Y 5) (* (EXPT X 5) 6)))
(+ (* 3 (* (EXPT X 5) 6))
(+ (* 6 (* (EXPT Z 4) (* (EXPT X 2) 3)))
(+ (* 2 (* (EXPT Z 4) (* X 2)))
(+ (* 2 (EXPT Y 5)) 2)))))))

-Taoufik

comp.lang.lisp

algebraic simplification

Taoufik Dachraoui

Taoufik Dachraoui

Taoufik Dachraoui

x Login to ForumsZone