;;;; Example of data-driven programming - first try
;;;; Program to do symbolic differentiation
;;;; ------------------------------------------------------------
;;;; stuff to implement data base of differentiation functions
(defvar *deriv-fn-hash* (make-hash-table)
"hash table used for symbolic differentiation.
Key: math function, e.g. sin
Value: lisp function to take symbolic derivative. Should have one arg, the
expression to be differentiated.")
;;; the following is useful during debugging because reload of file in
;;; same core image does not redo defvar
(defun clear-deriv-fns ()
"Reset data base of derivative fns to empty"
(setq *deriv-fn-hash* (make-hash-table)))
(defun set-deriv-fn (math-fn deriv-computer)
"Store deriv-computer as the derivative code for math-fn."
(setf (gethash math-fn *deriv-fn-hash*) deriv-computer))
(defun deriv-fn (math-fn)
"Returns deriv-computer that is the derivative code for math-fn.
deriv-computer should be lisp functoin that take one arg -
the expression to be differentiated"
(gethash math-fn *deriv-fn-hash*))
;;;; ------------------------------------------------------------
;;;; code to do differentiation
(defun deriv (expr)
"Take symbolic deriv of expr. Expr is in prefix form, e.g. (sin (+ 1 x))"
(if (atom expr) ; non-list should be a constant or x
(if (eq expr 'x) 1 0) ; deriv of constant is 0, of x is 1
;; else expr is a list
(let ((deriv-computer (deriv-fn (car expr)))) ; look up fn to do deriv
(if deriv-computer
(funcall deriv-computer expr)
(default-deriv expr))))) ; if no deriv fn use default-deriv
(defun default-deriv (expr)
"Computes deriv of (F ...). Actually, it just returns (d/dx (F ...))"
(list 'd/dx expr))
;;;; ------------------------------------------------------------
;;;; specific derivative functions
(defun deriv-cos (expr)
"take deriv of expr, assuming main functor of expr is cos"
(list '- (list '* (list 'sin expr) (deriv (cadr expr)))))
(set-deriv-fn 'cos 'deriv-cos)
;;;; hmm... this looks like a job for .... backquote `
;;;;==================================================================
;;;; Example of data-driven programming - second try
;;;; Program to do symbolic differentiation
;;;; ------------------------------------------------------------
;;;; stuff to implement data base of differentiation functions
(defvar *deriv-fn-hash* (make-hash-table)
"hash table used for symbolic differentiation.
Key: math function, e.g. sin
Value: lisp function to take symbolic derivative. Should have one arg, the
expression to be differentiated.")
;;; the following is useful during debugging because reload of file in
;;; same core image does not redo defvar
(defun clear-deriv-fns ()
"Reset data base of derivative fns to empty"
(setq *deriv-fn-hash* (make-hash-table)))
(defun set-deriv-fn (math-fn deriv-computer)
"Store deriv-computer as the derivative code for math-fn."
(setf (gethash math-fn *deriv-fn-hash*) deriv-computer))
(defun deriv-fn (math-fn)
"Returns deriv-computer that is the derivative code for math-fn.
deriv-computer should be lisp functoin that take one arg -
the expression to be differentiated"
(gethash math-fn *deriv-fn-hash*))
;;;; ------------------------------------------------------------
;;;; code to do differentiation
(defun deriv (expr)
"Take symbolic deriv of expr. Expr is in prefix form, e.g. (sin (+ 1 x))"
(if (atom expr) ; non-list should be a constant or x
(if (eq expr 'x) 1 0) ; deriv of constant is 0, of x is 1
;; else expr is a list
(let ((deriv-computer (deriv-fn (car expr)))) ; look up fn to do deriv
(if deriv-computer
(funcall deriv-computer expr)
(default-deriv expr))))) ; if no deriv fn use default-deriv
(defun default-deriv (expr)
"Computes deriv of (F ...). Actually, it just returns (d/dx (F ...))"
(list 'd/dx expr))
;;;; ------------------------------------------------------------
;;;; specific derivative functions
(defun deriv-cos (expr)
"take deriv of expr, assuming main functor of expr is cos"
`(- (* (sin ,(cadr expr))
,(deriv (cadr expr)))))
(set-deriv-fn 'cos 'deriv-cos)
(defun deriv-sin (expr)
"take deriv of expr, assuming main functor of expr is sin"
`(* (cos ,(cadr expr))
,(deriv (cadr expr))))
(set-deriv-fn 'sin 'deriv-sin)
;;; hmm... a pattern! time for a utility function.
;;;;==================================================================
;;;; Example of data-driven programming - third try
;;;; Program to do symbolic differentiation
;;;; ------------------------------------------------------------
;;;; stuff to implement data base of differentiation functions
(defvar *deriv-fn-hash* (make-hash-table)
"hash table used for symbolic differentiation.
Key: math function, e.g. sin
Value: lisp function to take symbolic derivative. Should have one arg, the
expression to be differentiated.")
;;; the following is useful during debugging because reload of file in
;;; same core image does not redo defvar
(defun clear-deriv-fns ()
"Reset data base of derivative fns to empty"
(setq *deriv-fn-hash* (make-hash-table)))
(defun set-deriv-fn (math-fn deriv-computer)
"Store deriv-computer as the derivative code for math-fn."
(setf (gethash math-fn *deriv-fn-hash*) deriv-computer))
(defun deriv-fn (math-fn)
"Returns deriv-computer that is the derivative code for math-fn.
deriv-computer should be lisp functoin that take one arg -
the expression to be differentiated"
(gethash math-fn *deriv-fn-hash*))
;;;; ------------------------------------------------------------
;;;; code to do differentiation
(defun deriv (expr)
"Take symbolic deriv of expr. Expr is in prefix form, e.g. (sin (+ 1 x))"
(if (atom expr) ; non-list should be a constant or x
(if (eq expr 'x) 1 0) ; deriv of constant is 0, of x is 1
;; else expr is a list
(let ((deriv-computer (deriv-fn (car expr)))) ; look up fn to do deriv
(if deriv-computer
(funcall deriv-computer expr)
(default-deriv expr))))) ; if no deriv fn use default-deriv
(defun default-deriv (expr)
"Computes deriv of (F ...). Actually, it just returns (d/dx (F ...))"
(list 'd/dx expr))
;;;; ------------------------------------------------------------
;;;; utility function for derivative functions
(defun deriv-of-compose (new-fn expr)
"Expr is of form (F (G ...)).
Returns (* (new-fn (G ...)))"
`(* (,new-fn ,(cadr expr)) ,(deriv (cadr expr))))
;;;; ------------------------------------------------------------
;;;; specific derivative functions
(defun deriv-cos (expr)
"take deriv of expr, assuming main functor of expr is cos"
`(- ,(deriv-of-compose 'sin expr)))
(set-deriv-fn 'cos 'deriv-cos)
(defun deriv-sin (expr)
"take deriv of expr, assuming main functor of expr is sin"
(deriv-of-compose 'cos expr))
(set-deriv-fn 'sin 'deriv-sin)
(defun deriv-exp (expression)
"take deriv of expr, assuming main functor of expression is exp"
(deriv-of-compose 'exp expression))
(set-deriv-fn 'exp 'deriv-exp)
;;; however, this doesn't help for binary functions:
(defun deriv-* (expr)
"take derivative of a product"
`(+ (* ,(cadr expr) ,(deriv (caddr expr)))
(* ,(caddr expr) ,(deriv (cadr expr)))))
(set-deriv-fn '* 'deriv-*)
;;; hmmm - what we want is some way of describing a pattern ...
;;;;==================================================================
;;;; Example of data-driven programming - fourth try
;;;; Program to do symbolic differentiation
;;;; ------------------------------------------------------------
;;;; stuff to implement data base of differentiation functions
(defvar *deriv-fn-hash* (make-hash-table)
"hash table used for symbolic differentiation.
Key: math function, e.g. sin
Value: lisp function to take symbolic derivative. Should have one arg, the
expression to be differentiated.")
;;; the following is useful during debugging because reload of file in
;;; same core image does not redo defvar
(defun clear-deriv-fns ()
"Reset data base of derivative fns to empty"
(setq *deriv-fn-hash* (make-hash-table)))
(defun set-deriv-fn (math-fn deriv-computer)
"Store deriv-computer as the derivative code for math-fn."
(setf (gethash math-fn *deriv-fn-hash*) deriv-computer))
(defun deriv-fn (math-fn)
"Returns deriv-computer that is the derivative code for math-fn.
deriv-computer should be lisp functoin that take one arg -
the expression to be differentiated"
(gethash math-fn *deriv-fn-hash*))
;;;; ------------------------------------------------------------
;;;; code to do differentiation
(defun deriv (expr)
"Take symbolic deriv of expr. Expr is in prefix form, e.g. (sin (+ 1 x))"
(if (atom expr) ; non-list should be a constant or x
(if (eq expr 'x) 1 0) ; deriv of constant is 0, of x is 1
;; else expr is a list
(let ((deriv-computer (deriv-fn (car expr)))) ; look up fn to do deriv
(if deriv-computer
(funcall deriv-computer expr)
(default-deriv expr))))) ; if no deriv fn use default-deriv
(defun default-deriv (expr)
"Computes deriv of (F ...). Actually, it just returns (d/dx (F ...))"
(list 'd/dx expr))
;;;; ------------------------------------------------------------
;;;; utility functions for derivative functions
(defun deriv-pattern (pattern expr)
"Take deriv of expr, according to pattern.
(arg ) in pattern means th arg of expr where is a constant number
(deriv-of-arg ) in pattern means deriv of th arg of expr, where ditto.
E.g. for *
(+ (* (arg 1) (deriv-of-arg 2))
(* (arg 2) (deriv-of-arg 1)))"
;; this is like a copy-all-levels but replace (arg ...) and (deriv-of-arg ...)
(cond ((atom pattern) pattern)
((eq (car pattern) 'arg)
(nth (cadr pattern) expr))
((eq (car pattern) 'deriv-of-arg)
(deriv (nth (cadr pattern) expr)))
(t (loop for x in pattern collect (deriv-pattern x expr))))) ; recur
(defun deriv-of-compose (new-fn expr)
"Expr is of form (F (G ...)).
Returns (* (new-fn (G ...)))"
(deriv-pattern
`(* (,new-fn (arg 1))
(deriv-of-arg 1))
expr))
;;;; ------------------------------------------------------------
;;;; specific derivative functions
(defun deriv-cos (expr)
"take deriv of expr, assuming main functor of expr is cos"
`(- ,(deriv-of-compose 'sin expr)))
(set-deriv-fn 'cos 'deriv-cos)
(defun deriv-sin (expr)
"take deriv of expr, assuming main functor of expr is sin"
(deriv-of-compose 'cos expr))
(set-deriv-fn 'sin 'deriv-sin)
(defun deriv-exp (expression)
"take deriv of expr, assuming main functor of expression is exp"
(deriv-of-compose 'exp expression))
(set-deriv-fn 'exp 'deriv-exp)
(defun deriv-* (expr)
"take derivative of a product"
(deriv-pattern '(+
(* (arg 1) (deriv-of-arg 2))
(* (arg 2) (deriv-of-arg 1)))
expr))
(set-deriv-fn '* 'deriv-*)
(defun deriv-+ (expr)
"take derivative of a sum"
(deriv-pattern '(+
(deriv-of-arg 1)
(deriv-of-arg 2))
expr))
(set-deriv-fn '+ 'deriv-+)