;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ma; Base: 10 -*- ;; A basis for a simple mathematical expression program ;; constructed by overloading generic arithmetic. A simple computer ;; algebra system (CAS). Basic idea: by overloading +, *, etc the ops can use ;; symbols, not just numbers. The data type ma is used for math expressions ;; Use (ma 'x) or the "syntactic sugar" %x to create a math object x. ;; Richard Fateman, November, 2005 (eval-when '(:load-toplevel) (require "ga")(require "simpsimp") (require "p2i")(require "df")) (in-package :ma) ;; define the structure for a math expression. (defstruct (ma (:constructor ma (e)))e (simp nil)) ;; fundamentally, ma is any lisp expression, just with an "ma" tag. ;; we can add other info, e.g. "simp" flag. ;; ma objects will be printed in an infix form by p2i, with this ;; default print-object method. To see the "inside" lisp, of u, try (ma::ma-e u). ;; p2i is defined in the file p2i.lisp (defmethod print-object ((a ma) stream)(format stream "~a" (p2i (ma-e a)))) ;;A read macro hack to establish the syntactic sugar %x. You can also do %(+ x y z). ;; ;; %(+ foo bar) is the same as (ma '(+ foo bar)) (set-macro-character #\% #'(lambda(st char)(declare (ignore char))(ma (read st t nil t)))) ;; in a manner similar to the code in ga.lisp, we define some ;; routines to help use define the two-arg-X operations, this time ;; on ma objects, or mixed ma+number objects. (defmacro defarithmetic (op) (let ((two-arg (intern (concatenate 'string "two-arg-" (symbol-name op)) :ga )) ) `(progn ;; new defmethods for ma. (defmethod ,two-arg ((arg1 ma) (arg2 ma)) (ma (list ',op (ma-e arg1)(ma-e arg2)))) (defmethod ,two-arg ((arg1 number) (arg2 ma)) (ma (list ',op arg1 (ma-e arg2)))) (defmethod ,two-arg ( (arg1 ma)(arg2 number)) (ma (list ',op (ma-e arg1) arg2))) (compile ',two-arg) (compile ',op) ',op))) (defarithmetic +) (defarithmetic -) (defarithmetic *) (defarithmetic /) (defarithmetic expt) ;; A rule to define rules for ma only (defmacro r (op s) ;; `(progn (defmethod ,op ((a ma)) (ma (list ',op (ma-e a)))) (setf (get ',op 'diff)'(lambda(x) ,s)) ; store s, the derivative, unused for now. )) ;; add as many rules as you can think of here. ;; should insert them in the shadow list too. (r sin (cos x)) (r cos (* -1 (sin x))) (r tan (expt (cos x) -2)) (r asin (expt (+ 1 (* -1 (expt x 2))) -1/2)) (r acos (* -1 (expt (+ 1 (* -1 (expt x 2))) -1/2))) (r one-arg-atan (expt (+ 1 (expt x 2)) -1)) (r sinh (cosh x)) (r cosh (sinh x)) (r atanh (expt (1+ (* -1 (expt x 2))) -1)) (r one-arg-glog (expt x -1)) (r exp (exp x)) (r sqrt (* 1/2 (expt x -1/2))) (r abs x) ;; not always (r 1- 1) (r 1+ 1) ;; equality needs to be specified. Order predicates don't make sense. (defmethod two-arg-=((a ma) (b ma)) (cl::eql (ma-e a) (ma-e b))) (defmethod two-arg-=((a ma) (b t)) (cl::eql (ma-e a) b)) (defmethod two-arg-=((a t) (b ma)) (cl::eql (ma-e b) a)) (defmethod two-arg-=((a t) (b t)) (cl::eql a b)) (defmethod two-arg-/=((a t) (b t)) (not (two-arg-= a b))) ;; a way to declare functions of multiple arguments.. ;; at some future time, use ma::nr (defmacro nr (op) ;; `(progn (defmethod ,(car op) ,(cdr op) (ma (list ',(car op) ,@(cdr op) ))))) ;; (nr (foo3 a b c)) ; then we can ;; use foo3 as a generic function ;; for example, (foo3 1 (+ %x 3 4) 5) ;; instead of %(foo3 1 (+ %x 3 4) 5) ;;(nr (atan2 x y)) ;; define atan2 generally ;; but define it for numbers this way, as cl::atan ;;(defmethod atan2 ((a number)(b number))(cl::atan a b)) ;; how to deal with unknown functions of arb. number of args? e.g. ;;(defun bar(&rest x)(ma (list 'bar (cons 'seq x)))) ;;(defun seq(&rest x) (cons 'seq x)) ;; This next piece may be useless, but in :user package, try ;; (meval '(+ 3 x y(* 5 6))) --> 30+((3+x)+y) (defun cl-user::meval(r) (ma (ga::simp(ma-e(ga::eval (ga::re-intern r :ga)))))) ;;;;; The rest of this file looks at how to interface with ;; two simplifiers. One rudimentary simplifier is in the file simpsimp.lisp ;;Here's the interface: ;; This one destroys the unsimplified version (defmethod gasimp((x ma))(if (cl::eq (ma-simp x) 'gasimp) ; already simped x (let ((r(ga::simp (ma-e x)))) (setf (ma-e x) r) (setf (ma-simp x) 'gasimp) (if (numberp r) r x) ; demotes numbers? or just x? ))) (defmethod gasimp((x t)) x) ; not a math object? don't simplify it. (defmethod gasimp((z df::df)) ;how to simplify df of math objects (df::df (gasimp(df::df-f z))(gasimp(df::df-d z)))) (defmethod ga::ratsimp((x ma)) ;ratsimp is a more powerful simplifier for polys (if (cl::eq (ma-simp x) 'ratsimp) ; already simped x (let ((r(ratsimp (ma-e x)))) ;ratsimp defined in rat1.lisp and dependent files (setf (ma-e x) r) (setf (ma-simp x) 'ratsimp) (if (numberp r) r x) ; demotes numbers? or just x? ))) (defmethod ratexpand((x ma)) ;ratsimp is like ratsimp, using distr. law (if (cl::eq (ma-simp x) 'ratsimp) ; already simped x (let* ((r (ratexpand(ma-e x)))) (setf (ma-e x) r) (setf (ma-simp x) 'ratsimp) (if (numberp r) r x) ; demotes numbers? or just x? ))) (defmethod ratexpand((z df::df)) (df::df (ratexpand(df::df-f z))(ratexpand(df::df-d z)))) (defmethod ratsimp((x ma)) (if (cl::eq (ma-simp x) 'ratsimp) ; already simped x (let ((r(ratsimp (ma-e x)))) (setf (ma-e x) r) (setf (ma-simp x) 'ratsimp) (if (numberp r) r x) ; demotes numbers? or just x? ))) (defun simp(x)(gasimp x)) (defmethod unratsimp((x ma)) ;unset the simp flag of x (setf (ma-simp x) nil) x) ;; examples (defun ex(x)(ex1 x 1 15)) (defun ex1(x i lim) ;; generate Taylor summation exactly for exp() (if (= i lim) 0 (+ 1 (* x (ex1 x (+ i 1) lim)(expt i -1))))) (defun p(m x)(cond ((= m 0) 1) ((= m 1) x) (t (* (/ 1 m) (+ (* (- (* 2 m) 1) x (p (- m 1) x)) (* (- 1 m) (p (- m 2) x))))))) ;; that formula in infix form "(1/m)*((2*m-1)*x*p(m-1,x)+(1-m)*p(m-2,x))" ;; consider (gasimp (p 4 %x)) ;; (ratexpand *) yields the nicer form ;; (1/8)*(3+(-30)*x^2+35*x^4) ;; How to facilitate the insertion of lisp information into math data.. ;; Let us say that you have constructed a math object, say x+y+45, and ;; you wish to impose on it some information, that x should be ;; replaced by 3, or perhaps by y-45. ;; (setf target %(+ x y 45)) ;; (masubst 3 %x target) ;; (masubst %(+ y -45) %x target) (defmethod masubst ((new ma) (old ma) (targ ma)) (simp (ma (subst (ma-e new)(ma-e old)(ma-e targ) :test #'equal)))) (defmethod masubst ((new t) (old ma) (targ ma)) (simp (ma (subst new (ma-e old)(ma-e targ) :test #'equal)))) ;; this next method is not as easy to characterize semantically. It ;; looks at Lisp bindings and tries calling functions again. (defmethod meval ((targ ma)) (simp (meval1 (ma-e targ)))) (defun meval1 (s)(cond((numberp s) s) ((symbolp s)(if (boundp s) (ma (symbol-value s)) (ma s))) ((ma-p s) (ma (meval1 (ma-e s)))) (t (apply (car s)(mapcar #'meval1 (cdr s)))))) ;; e.g. try (setf x 3) (meval target)