misc-code/derive.lisp

;;;; derive.lisp
;;;;
;;;; Copyright (c) 2015 Samuel W. Flint <swflint@flintfam.org>

(defpackage #:derive
  (:use #:cl)
  (:export :derive
           :csc
           :sec
           :cot))

(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))))))

(defun csc (x)
  "csc -- (csc x)
Calculate the cosecant of x"
  (/ (sin x)))

(defun sec (x)
  "sec -- (sec x)
Calculate the secant of x"
  (/ (cos x)))

(defun cot (x)
  "cot -- (cot x)
Calculate the cotangent of x"
  (/ (tan x)))

;;; End derive