Code: Select all
(defun differentiate (F V)
(cond ((constant-p F)(make-constant 0))
((variable-p F) (if (equal (make-variable-name F)(make-variable-name V)
(make-constant 1)
(make-constant 0)))
((negation-p F)(make-negation (differentiate(negation-arg F) V)))
((sum-p F)(make-sum(differentiate(sum-operand-1 F) V)
(differentiate(sum-operand-2 F) V)))
((difference-p F)(make-difference(differentiate(difference-operand-1 F) V)
(differentiate(difference-operand-2 F) V)))
((product-p F)(make-sum(make-product(product-operand-1 F)(differentiate(product-operand-2 F)V))
(make-product(product-operand-2 F)(differentiate(product-operand-1 F) V))))
((power-p F)(make-product(make-product(power-exponent F)
(make-power(power-base F)
(1-(power-exponent F)))))
(differentiate(power-base F) V)))))
;;===================================================================
;; SYMBOLS
(defconstant *constant-symbols* '(A B C D E F G H M N))
(defconstant *variable-symbols* '(U V W X Y Z))
(defconstant *negation-symbol* '-)
(defconstant *sum-symbol* '+)
(defconstant *difference-symbol '-)
(defconstant *product-symbol '*)
(defconstant *quotient-symbol '/)
(defconstant *power-product* '**)
;;===================================================================
;; READERS
;;---------------------------------------------
;; OPERATORS
(defun sum-operator (F) (second F))
;;---------------------------------------------
;; OPERANDS
(defun sum-operand-1 (F)(first F))
(defun sum-operand-2 (F (third F))
(defun difference-operand-1 (F)(first F))
(defun difference-operand-2 (F)(third F))
(defun product-operand-1 (F)(first F))
(defun product-operand-2 (F)(third F))
(defun power-base (F)(second F))
(defun power-exponent (F)(third F))
;;===================================================================
;; INQUISITORS
(defun constant-p (F)
(or numberp F)
(member F *constant-symbols*))
(defun variable-p (F)
(member F *variable-symbols*))
(defun negation-p (F)
(and (listp F)
(eq (first F) *negation-symbol*) (nil (rest (rest F)))))
(defun sum-p (F)
(and (listp F)
(>= (length F) 3)
(equal (sum-operator F) *sum-symbol*)))
;;===================================================================
;; CONSTRUCTORS
(defun make-constant(num) num)
(defun make-variable-name (V) V)
(defun make-negation (F)
(cond ((and (eq 0 F) F)
(
(defun make-sum (F G)
(cond ((eq 0 F) G)
((eq 0 G) F)
((and(numberp F)(numberp G))(+ F G))
(else (list F *sum-symbol* G))))
(defun make-difference (F G)
(cond ((eq 0 F)(make-negation G))
((eq 0 G) F)
((equal F G) 0)
((and(numberp F)(numberp G)(- F G))
(t(list F *difference symbol* G)))))
(defun make-product (F G)
(cond ((or(eq 0 F)(eq 0 G)) 0)
((eq 1 F) G)
((eq 1 G) F)
((and(numberp F)(numberp G))(* F G))
(else(list F *product-symbol* G))))
;;===================================================================
;; The below is for personal testing only. Once the program runs and
;; is tested to programmer's satisfaction, it would be removed. It is
;; included here as an illustration only.
;;
(defun nice-diff (F V)
(format t "FUNCTION: ~a~%VARIABLE: ~a~% RESULT: ~A~%~%" F V (differentiate F V)))
(defun t1 () (nice-diff 'x 'x))
(defun t2 () (nice-diff '(x + x) 'x))
(defun t3 () (nice-diff '(x + (x + x)) 'x))
(defun t4 () (nice-diff '((x + x) + (x + x)) 'x))
(defun testall ()
(t1)
(t2)
(t3)
(t4))