home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / SOFTWARE / LANGS / PCLISP30.ZIP / DIFF.L (.txt) next >
Lisp/Scheme  |  1986-10-15  |  4KB  |  108 lines
  1. ;          DIFF.L FOR PC-LISP V2.13
  2. ;          ~~~~~~~~~~~~~~~~~~~~~~~~
  3. ;    This module is kind of fun, it takes an expression in a prefix lisp
  4. ; like form and will compute the derivative of the expression with respect
  5. ; to the indicated variable. After symbolic differentiation is done some
  6. ; folding is done to remove redundant stuff from the expression. Eg we get
  7. ; rid of things multiplied by zero, and fold things with 0 added to them,
  8. ; or things raised to the power 1. This reduces the output complexity  
  9. ; significantly.          
  10. ;
  11. ;          Peter Ashwood-Smith
  12. ;          September 1986.
  13. ;
  14. ; D(e,X) -
  15. ;          Will compute the symbolic derivative of expression e with respect
  16. ; to varible X. We take the expression in standard lisp prefix form and will
  17. ; use the following rules of differentiation.
  18. ;
  19. ;         D(x)    = 1
  20. ;         D(a)    = 0
  21. ;         D(ln u) = D(u)/u 
  22. ;         D(u+v)  = D(u)+D(v)
  23. ;         D(u-v)  = D(u)-D(v)
  24. ;         D(u*v)  = D(u)*v + u*D(v)
  25. ;         D(u/v)  = D(u)*v + (u*D(v))/v^2
  26. ;         D(v^u)  = (v^u)*(u*D(v)/v + D(u)*ln(v))
  27. ;
  28. (defun  D(e X &aux u v)
  29.  (cond ((equal e X) 1) 
  30.        ((atom e) 0)           
  31.        (t (setq u (cadr e) v (caddr e))
  32.       (caseq (car e)
  33.          (ln `(/ ,(D u X) ,u)) 
  34.          (+  `(+ ,(D u X) ,(D v X)))
  35.          (-  `(- ,(D u X) ,(D v X)))
  36.          (*  `(+  (* ,(D u X) ,v) (* ,(D v X) ,u)))
  37.          (/  `(-  (/ ,(D u X) ,v)
  38.               (/ (* ,u ,(D v X)) (^ ,v 2))))
  39.          (^  `(* ,e  (+ (/ (* ,v ,(D u X)) ,u)
  40.                    (* ,(D v X) (ln ,u)))))
  41.          (t (princ "ERROR") (exit)]
  42.  
  43. ;
  44. ; Fold(e) -
  45. ;         Will traverse the expression 'e' and construct a new expression.
  46. ; It checks for things like (* 1 <exp>), (* <exp> 0), (^ <exp> 1), (+ <exp> 0)
  47. ; and replaces them with the appropriate things <exp>,0,<exp> and <exp>
  48. ; respectively. These simple algabraic modifications greatly reduce the output
  49. ; complexity but do not do a complete job by any means. We use the macros
  50. ; ?times, ?plus and ?power to do the dirty work for us. We set displace-macros
  51. ; to t to cause PC-LISP to substitute the code into the body of Fold thus
  52. ; making it much faster.
  53. ;
  54.  
  55. (setq displace-macros t)
  56.  
  57. (defmacro ?times(v e)
  58.        `(and (eq (car ,e) '*) (member ,v ,e] 
  59.  
  60. (defmacro ?plus(v e)
  61.        `(and (eq (car ,e) '+) (member ,v ,e] 
  62. (defmacro ?power(v e)
  63.        `(and (eq (car ,e) '^) (eq (caddr ,e) ,v] 
  64.  
  65. (defun Fold(e)
  66.        (cond ((atom e) e)
  67.          (t (setq e (cons (Fold (car e)) (Fold (cdr e))))
  68.         (cond ((?times 0 e) 0)
  69.               ((?times 1 e) (cond ((eq (cadr e) 1) (caddr e))
  70.                       (t (cadr e))))
  71.               ((?power 1 e) (cadr e))
  72.               ((?plus  0 e) (cond ((eq (cadr e) 0) (caddr e))
  73.                       (t (cadr e))))
  74.               (t e]
  75.  
  76. (defun Differentiate(e x)
  77.        (Fold (D e x)] 
  78.  
  79. ; ----------------- end if differentiate module ------------------
  80.  
  81.  
  82. (princ "\t\tSYMBOLIC DIFFERENCIATION\n\n")
  83. (princ "Following is the Input Expression Y\n")
  84. (setq y '(* x (ln (+ x a))))
  85. (pp-form y)
  86.  
  87. (princ "\nComputing 1st Derivitive of Y with respect to x, Y'\n")
  88. (setq Dy (Differentiate y 'x))
  89. (pp-form Dy)
  90.  
  91. (princ "\nComputing 2nd Derivitive of Y with respect to x, Y''\n")
  92. (setq DDy (Differentiate Dy 'x))
  93. (pp-form DDy)
  94.  
  95. (princ "\nComputing 3rd Derivitive of Y with respect to x, Y'''\n")
  96. (setq DDDy (Differentiate DDy 'x))
  97. (pp-form DDDy)
  98.  
  99. (princ "\nComputing 4th Derivitive of Y with respect to x, Y''''\n")
  100. (setq DDDDy (Differentiate DDDy 'x))
  101. (pp-form DDDDy)
  102.  
  103. (princ "\nComputing 5th Derivitive of Y with respect to x, Y'''''\n")
  104. (setq DDDDDy (Differentiate DDDDy 'x))
  105. (pp-form DDDDDy)
  106.  
  107. (princ "\n\nDone (finally)\n")
  108.