derive.lisp 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105
  1. ;;;; derive.lisp
  2. ;;;;
  3. ;;;; Copyright (c) 2015 Samuel W. Flint <swflint@flintfam.org>
  4. (defpackage #:derive
  5. (:use #:cl)
  6. (:export :derive
  7. :csc
  8. :sec
  9. :cot))
  10. (in-package #:derive)
  11. ;;; "derive" goes here.
  12. (defun derive (equation)
  13. "derive -- (derive equation)
  14. Derives an equation using the normal rules of differentiation."
  15. (declare (cons equation))
  16. (let ((op (first equation)))
  17. (cond
  18. ((member op '(sin cos tan csc sec cot sqrt))
  19. (chain equation))
  20. ((equal op 'expt)
  21. (power (rest equation)))
  22. ((equal op '*)
  23. (mult (rest equation)))
  24. ((equal op '/)
  25. (div (rest equation)))
  26. ((or (equal op '+)
  27. (equal op '-))
  28. (apply #'plus/minus op (rest equation)))
  29. ((numberp op)
  30. 0)
  31. (t
  32. 1))))
  33. (defun plus/minus (op &rest args)
  34. "plus/minus -- (plus/minus op &rest args)
  35. Derive for plus/minus"
  36. (declare (symbol op)
  37. (cons args))
  38. (let ((out (list op)))
  39. (loop for arg in args
  40. do (let ((derivative (derive (if (not (listp arg)) (list arg) arg))))
  41. (if (eq 0 derivative)
  42. nil
  43. (push derivative out))))
  44. (if (equal (list op) out)
  45. nil
  46. (reverse out))))
  47. (defun mult (equation)
  48. "mult -- (mult equation)
  49. Derive multiplication"
  50. (if (= (length equation) 2)
  51. (if (numberp (first equation))
  52. `(* ,(first equation) ,(derive (if (not (listp (second equation))) (list (second equation)) (second equation))))
  53. (if (numberp (second equation))
  54. `(* ,(second equation) ,(derive (if (not (listp (first equation))) (list (first equation)) (first equation))))
  55. `(+ (* ,(first equation) ,(derive (second equation)))
  56. (* ,(second equation) ,(derive (first equation))))))
  57. (mult (list (first equation) (mult (rest equation))))))
  58. (defun div (equation)
  59. "div -- (div equation)
  60. Derive using quotient rule"
  61. (let ((numerator (nth 0 equation))
  62. (denominator (nth 1 equation)))
  63. `(/ (- (* ,numerator ,(derive denominator))
  64. (* ,denominator ,(derive numerator)))
  65. (expt ,denominator 2))))
  66. (defun chain (equation)
  67. "chain -- (chain equation)
  68. Apply the chain rule to the equation"
  69. (declare (cons equation))
  70. )
  71. (defun power (eq)
  72. "power -- (power rest)
  73. Apply the Power Rule"
  74. (declare (cons eq))
  75. (let ((equation (nth 0 eq))
  76. (power (nth 1 eq)))
  77. (if (listp equation)
  78. `(* ,power (expt ,(derive equation) ,(1- power)))
  79. `(* ,power (expt ,equation ,(1- power))))))
  80. (defun csc (x)
  81. "csc -- (csc x)
  82. Calculate the cosecant of x"
  83. (/ (sin x)))
  84. (defun sec (x)
  85. "sec -- (sec x)
  86. Calculate the secant of x"
  87. (/ (cos x)))
  88. (defun cot (x)
  89. "cot -- (cot x)
  90. Calculate the cotangent of x"
  91. (/ (tan x)))
  92. ;;; End derive