Finished the derivative program

derive2.lisp

@@ -6,7 +6,9 @@
   (:use #:cl)
   (:export :derive
            :csc
-           :sec))
+           :sec
+           :define-equation-functions
+           :take-derivative))
 
 (in-package #:derive2)
 
@@ -42,6 +44,13 @@
              *rules*)
        ',name)))
 
+(defun get-expansion (expression)
+  (let (expansion-function)
+    (loop for (name test expander) in *rules*
+       do (if (apply test expression)
+              (setf expansion-function expander)))
+    expansion-function))
+
 (defun derive (function)
   (declare (cons function))
   (let ((op (first function)))
@@ -52,10 +61,7 @@
           (= 1 (length function)))
        1)
       (t
-       (let ((expansion-function))
-         (loop for (name test expander) in *rules*
-            do (if (apply test function)
-                   (setf expansion-function expander)))
+       (let ((expansion-function (get-expansion function)))
          (if (functionp expansion-function)
              (apply expansion-function (rest function))
              (error "Undefined expansion: ~a" op)))))))
@@ -80,6 +86,28 @@ Calculate the secant of x"
      `(+ (* ,first ,(derive (if (listp second) second (list second))))
          (* ,second ,(derive (if (listp first) first (list first))))))))
 
+(def-expansion mult/3+ (* 3 >=) (first &rest rest)
+  (derive `(* ,first ,(cons '* rest))))
+
+(def-expansion div/2 (/ 2) (numerator denominator)
+  `(/ (- (* ,numerator ,(derive denominator))
+         (* ,denominator ,(derive numerator)))
+      (expt ,denominator 2)))
+
+(def-expansion plus/2+ (+ 2 >=) (&rest clauses)
+  `(+ ,@(map 'list #'(lambda (clause)
+                       (if (listp clause)
+                           (derive clause)
+                           (derive (list clause))))
+             clauses)))
+
+(def-expansion minus/2+ (- 2 >=) (&rest clauses)
+  `(- ,@(map 'list #'(lambda (clause)
+                       (if (listp clause)
+                           (derive clause)
+                           (derive (list clause))))
+             clauses)))
+
 (def-expansion exp/1 (exp 1) (expression)
   (if (listp expression)
       `(* (expt ,expression) ,(derive expression))
@@ -95,6 +123,42 @@ Calculate the secant of x"
 (def-expansion log/1 (log 1) (expression)
   `(/ ,(derive (if (listp expression) expression (list expression))) ,expression))
 
-(def-expansion log/2 (log 2) (number base))
+(def-expansion log/2 (log 2) (number base)
+  (declare (ignorable number base))
+  `(/ (derive (cons 'log number)) (log ,base)))
+
+(def-expansion sin/1 (sin 1) (arg)
+  `(* (cos ,arg) ,(derive arg)))
+
+(def-expansion cos/1 (cos 1) (arg)
+  `(* (- (sin ,arg)) ,(derive arg)))
+
+(def-expansion tan/1 (tan 1) (arg)
+  `(* (expt (sec ,arg) 2) ,(derive arg)))
+
+(def-expansion csc/1 (csc 1) (arg)
+  `(* (- (csc ,arg)) (cot ,arg) ,(derive arg)))
+
+(def-expansion sec/1 (sec 1) (arg)
+  `(* (sec ,arg) (tan ,arg) ,(derive arg)))
+
+(def-expansion cot/1 (cot 1) (arg)
+  `(* (- (expt (csc ,arg) 2)) ,(derive arg)))
+
+(defmacro define-equation-functions (name variable equation)
+  (let ((derivative-name
+         (intern
+          (string-upcase
+           (format nil "d/d~a-~a" variable name))))
+        (derivative (derive equation)))
+    `(progn
+       (defun ,name (,variable)
+         ,equation)
+       (defun ,derivative-name (,variable)
+         ,derivative))))
+
+(defmacro take-derivative (equation)
+  (let ((derivative (derive equation)))
+    `',derivative))
 
 ;;; End derive2