Permalink
Browse files

symbols and symbolic differentiation

  • Loading branch information...
1 parent c3defb9 commit 632098336500ffd8accb44a305123613b6aa5471 @sarabander committed Aug 28, 2011
Showing with 484 additions and 0 deletions.
  1. +14 −0 2.3/2.53.scm
  2. +29 −0 2.3/2.54.scm
  3. +8 −0 2.3/2.55.scm
  4. +81 −0 2.3/2.56.scm
  5. +64 −0 2.3/2.57.scm
  6. +288 −0 2.3/2.58.scm
View
@@ -0,0 +1,14 @@
+
+(define (memq item x)
+ (cond ((null? x) false)
+ ((eq? item (car x)) x)
+ (else (memq item (cdr x)))))
+
+(list 'a 'b 'c) ; '(a b c)
+(list (list 'george)) ; '((george))
+(cdr '((x1 x2) (y1 y2))) ; '((y1 y2))
+(cadr '((x1 x2) (y1 y2))) ; '(y1 y2)
+(pair? (car '(a short list))) ; false
+(memq 'red '((red shoes) (blue socks))) ; false
+(memq 'red '(red shoes blue socks)) ; '(red shoes blue socks)
+
View
@@ -0,0 +1,29 @@
+
+(define (my-equal? a b)
+ (cond ((and (empty? a)
+ (empty? b))
+ true)
+ ((and (number? a)
+ (number? b)
+ (eq? a b))
+ true)
+ ((and (symbol? a)
+ (symbol? b)
+ (eq? a b))
+ true)
+ ((and (list? a)
+ (list? b)
+ (my-equal? (car a) (car b))
+ (my-equal? (cdr a) (cdr b)))
+ true)
+ (else
+ false)))
+
+(my-equal? '(this is a list) '(this is a list)) ; true
+(my-equal? '(this is a list) '(this (is a) list)) ; false
+
+(my-equal? 'e 'r) ; false
+(my-equal? 'w 'w) ; true
+
+(my-equal? 7 12) ; false
+(my-equal? 3 +3) ; true
View
@@ -0,0 +1,8 @@
+
+(car ''abracadabra)
+
+;; What this really means, is:
+(car (quote (quote abracadabra)))
+
+;; or alternatively:
+(car '(quote abracadabra)) ; which gives back 'quote
View
@@ -0,0 +1,81 @@
+
+;; From the book, extended
+(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 (multiplicand exp) var))
+ (make-product (deriv (multiplier exp) var)
+ (multiplicand exp))))
+ ((exponentiation? exp) ; this
+ (make-product ; is
+ (make-product (exponent exp) ; new
+ (make-exponentiation (base exp) ;
+ (sub1 (exponent exp)))) ;
+ (deriv (base exp) var))) ;
+ (else
+ (error "unknown expression type - DERIV" exp))))
+
+(define (variable? x) (symbol? x))
+
+(define (same-variable? v1 v2)
+ (and (variable? v1) (variable? v2) (eq? v1 v2)))
+
+(define (sum? x)
+ (and (pair? x) (eq? (car x) '+)))
+
+(define (addend s) (cadr s))
+
+(define (augend s) (caddr s))
+
+(define (product? x)
+ (and (pair? x) (eq? (car x) '*)))
+
+(define (multiplier p) (cadr p))
+
+(define (multiplicand p) (caddr p))
+
+(define (make-sum a1 a2)
+ (cond ((=number? a1 0) a2)
+ ((=number? a2 0) a1)
+ ((and (number? a1) (number? a2)) (+ a1 a2))
+ (else (list '+ a1 a2))))
+
+(define (=number? exp num)
+ (and (number? exp) (= exp num)))
+
+(define (make-product m1 m2)
+ (cond ((or (=number? m1 0) (=number? m2 0)) 0)
+ ((=number? m1 1) m2)
+ ((=number? m2 1) m1)
+ ((and (number? m1) (number? m2)) (* m1 m2))
+ (else (list '* m1 m2))))
+
+;; Added procedures for differentiating variables raised to powers
+(define (exponentiation? x)
+ (and (pair? x) (eq? (car x) '**)))
+
+(define (base p) (cadr p))
+
+(define (exponent p) (caddr p))
+
+(define (make-exponentiation base exponent)
+ (cond ((=number? exponent 0) 1)
+ ((=number? exponent 1) base)
+ ((and (number? base) (number? exponent)) (** base exponent))
+ (else (list '** base exponent))))
+
+(define ** expt)
+
+;; Tests
+(deriv '(** x 4) 'x) ; '(* 4 (** x 3))
+
+(deriv '(+ (** x 3) (* 5 x)) 'x) ; '(+ (* 3 (** x 2)) 5)
+
+(deriv '(+ 3 x x 4 7) 'x)
View
@@ -0,0 +1,64 @@
+
+;; Only augend and multiplicand needed modification
+
+(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 (multiplicand exp) var))
+ (make-product (deriv (multiplier exp) var)
+ (multiplicand exp))))
+ ((exponentiation? exp) ; this
+ (make-product ; is
+ (make-product (exponent exp) ; new
+ (make-exponentiation (base exp) ;
+ (sub1 (exponent exp)))) ;
+ (deriv (base exp) var))) ;
+ (else
+ (error "unknown expression type - DERIV" exp))))
+
+(define (sum? x)
+ (and (pair? x) (eq? (car x) '+)))
+
+(define (addend s) (cadr s))
+
+;; Extended
+(define (augend s)
+ (if (= (length s) 3)
+ (caddr s)
+ (cons '+ (cddr s))))
+
+(define (product? x)
+ (and (pair? x) (eq? (car x) '*)))
+
+(define (multiplier p) (cadr p))
+
+;; Extended
+(define (multiplicand p)
+ (if (= (length p) 3)
+ (caddr p)
+ (cons '* (cddr p))))
+
+(define (make-sum a1 a2)
+ (cond ((=number? a1 0) a2)
+ ((=number? a2 0) a1)
+ ((and (number? a1) (number? a2)) (+ a1 a2))
+ (else (list '+ a1 a2))))
+
+(define (make-product m1 m2)
+ (cond ((or (=number? m1 0) (=number? m2 0)) 0)
+ ((=number? m1 1) m2)
+ ((=number? m2 1) m1)
+ ((and (number? m1) (number? m2)) (* m1 m2))
+ (else (list '* m1 m2))))
+
+;; Tests
+(deriv '(* x y (+ x 3)) 'x)
+(deriv '(+ (* 4 x) (* 7 (** x 3)) (* x 5)) 'x)
+(deriv '(* 4 x (** (+ x (* 6 y) 2) 3) z) 'y)
Oops, something went wrong.

0 comments on commit 6320983

Please sign in to comment.