From: Ramakrishnan Muthukrishnan Date: Tue, 23 Nov 2010 18:22:24 +0000 (+0530) Subject: symbolic differentiation system X-Git-Url: https://git.rkrishnan.org/pf/content/simplejson/install.html?a=commitdiff_plain;h=639df77a2fb2f2483593a5e67ba739d503713cac;p=sicp.git symbolic differentiation system --- diff --git a/src/sicp/ch2_3_deriv.rkt b/src/sicp/ch2_3_deriv.rkt new file mode 100644 index 0000000..65a19ad --- /dev/null +++ b/src/sicp/ch2_3_deriv.rkt @@ -0,0 +1,52 @@ +#lang racket + +(define (deriv exp var) + (cond ((number? exp) 0) + ((variable? exp) (if (same-variable? exp var) 1 0)) + ((sum? exp) (make-sum (deriv (addend exp) var) + (deriv (augend exp) var))) + ((product? exp) (make-sum (make-product (multiplier exp) + (deriv (multiplicant exp) var)) + (make-product (multiplicant exp) + (deriv (multiplier exp) var)))) + (else (error "unknown type of expression - deriv" exp)))) + +(define (variable? x) (symbol? x)) + +(define (same-variable? x y) + (and (variable? x) (variable? y) (eq? x y))) + +;; sum +(define (make-sum x y) + (cond ((equal? x 0) y) + ((equal? y 0) x) + ((and (number? x) (number? y)) (+ x y)) + ((equal? x y) (make-product 2 x)) + (else (list '+ x y)))) + +(define (make-product x y) + (cond ((equal? x 1) y) + ((equal? y 1) x) + ((equal? x 0) 0) + ((equal? y 0) 0) + (else (list '* x y)))) + +(define (sum? exp) + (and (pair? exp) + (eq? (car exp) '+))) + +(define (product? exp) + (and (pair? exp) + (eq? (car exp) '*))) + +(define (addend exp) (car (cdr exp))) +(define (augend exp) (car (cdr (cdr exp)))) + +(define (multiplicant exp) (car (cdr exp))) +(define (multiplier exp) (car (cdr (cdr exp)))) + + +;; tests +(deriv '(+ x 3) 'x) +(deriv '(* x y) 'x) +(deriv '(* (* x y) (+ x 3)) 'x) \ No newline at end of file