|
|
@@ -0,0 +1,87 @@
|
|
|
+;;;; derive.lisp
|
|
|
+;;;;
|
|
|
+;;;; Copyright (c) 2015 Samuel W. Flint <swflint@flintfam.org>
|
|
|
+
|
|
|
+(defpackage #:derive
|
|
|
+ (:use #:cl)
|
|
|
+ (:export :derive))
|
|
|
+
|
|
|
+(in-package #:derive)
|
|
|
+
|
|
|
+;;; "derive" goes here.
|
|
|
+
|
|
|
+(defun derive (equation)
|
|
|
+ "derive -- (derive equation)
|
|
|
+Derives an equation using the normal rules of differentiation."
|
|
|
+ (declare (cons equation))
|
|
|
+ (let ((op (first equation)))
|
|
|
+ (cond
|
|
|
+ ((member op '(sin cos tan csc sec cot sqrt))
|
|
|
+ (chain equation))
|
|
|
+ ((equal op 'expt)
|
|
|
+ (power (rest equation)))
|
|
|
+ ((equal op '*)
|
|
|
+ (mult (rest equation)))
|
|
|
+ ((equal op '/)
|
|
|
+ (div (rest equation)))
|
|
|
+ ((or (equal op '+)
|
|
|
+ (equal op '-))
|
|
|
+ (apply #'plus/minus op (rest equation)))
|
|
|
+ ((numberp op)
|
|
|
+ 0)
|
|
|
+ (t
|
|
|
+ 1))))
|
|
|
+
|
|
|
+(defun plus/minus (op &rest args)
|
|
|
+ "plus/minus -- (plus/minus op &rest args)
|
|
|
+Derive for plus/minus"
|
|
|
+ (declare (symbol op)
|
|
|
+ (cons args))
|
|
|
+ (let ((out (list op)))
|
|
|
+ (loop for arg in args
|
|
|
+ do (let ((derivative (derive (if (not (listp arg)) (list arg) arg))))
|
|
|
+ (if (eq 0 derivative)
|
|
|
+ nil
|
|
|
+ (push derivative out))))
|
|
|
+ (if (equal (list op) out)
|
|
|
+ nil
|
|
|
+ (reverse out))))
|
|
|
+
|
|
|
+(defun mult (equation)
|
|
|
+ "mult -- (mult equation)
|
|
|
+Derive multiplication"
|
|
|
+ (if (= (length equation) 2)
|
|
|
+ (if (numberp (first equation))
|
|
|
+ `(* ,(first equation) ,(derive (if (not (listp (second equation))) (list (second equation)) (second equation))))
|
|
|
+ (if (numberp (second equation))
|
|
|
+ `(* ,(second equation) ,(derive (if (not (listp (first equation))) (list (first equation)) (first equation))))
|
|
|
+ `(+ (* ,(first equation) ,(derive (second equation)))
|
|
|
+ (* ,(second equation) ,(derive (first equation))))))
|
|
|
+ (mult (list (first equation) (mult (rest equation))))))
|
|
|
+
|
|
|
+(defun div (equation)
|
|
|
+ "div -- (div equation)
|
|
|
+Derive using quotient rule"
|
|
|
+ (let ((numerator (nth 0 equation))
|
|
|
+ (denominator (nth 1 equation)))
|
|
|
+ `(/ (- (* ,numerator ,(derive denominator))
|
|
|
+ (* ,denominator ,(derive numerator)))
|
|
|
+ (expt ,denominator 2))))
|
|
|
+
|
|
|
+(defun chain (equation)
|
|
|
+ "chain -- (chain equation)
|
|
|
+Apply the chain rule to the equation"
|
|
|
+ (declare (cons equation))
|
|
|
+ )
|
|
|
+
|
|
|
+(defun power (eq)
|
|
|
+ "power -- (power rest)
|
|
|
+Apply the Power Rule"
|
|
|
+ (declare (cons eq))
|
|
|
+ (let ((equation (nth 0 eq))
|
|
|
+ (power (nth 1 eq)))
|
|
|
+ (if (listp equation)
|
|
|
+ `(* ,power (expt ,(derive equation) ,(1- power)))
|
|
|
+ `(* ,power (expt ,equation ,(1- power))))))
|
|
|
+
|
|
|
+;;; End derive
|
