]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ex2_58a.rkt
rewrite `quote->cons' using `match'.
[sicp.git] / src / sicp / ex2_58a.rkt
1 #lang racket
2
3 (define (deriv exp var)
4   (cond ((number? exp) 0)
5         ((variable? exp) (if (same-variable? exp var) 1 0))
6         ((sum? exp) (make-sum (deriv (addend exp) var)
7                               (deriv (augend exp) var)))
8         ((product? exp) (make-sum (make-product (multiplier exp)
9                                                 (deriv (multiplicant exp) var))
10                                   (make-product (multiplicant exp)
11                                                 (deriv (multiplier exp) var))))
12         (else (error "unknown type of expression - deriv" exp))))
13
14 (define (variable? x) (symbol? x))
15
16 (define (same-variable? x y)
17   (and (variable? x) (variable? y) (eq? x y)))
18
19 ;; sum
20 (define (make-sum x y) 
21   (cond ((equal? x 0) y)
22         ((equal? y 0) x)
23         ((and (number? x) (number? y)) (+ x y))
24         ((equal? x y) (make-product 2 x))
25         (else (list x '+ y))))
26
27 (define (make-product x y) 
28   (cond ((equal? x 1) y)
29         ((equal? y 1) x)
30         ((equal? x 0) 0)
31         ((equal? y 0) 0)
32         (else (list x '* y))))
33
34 (define (sum? exp) 
35   (and (pair? exp) 
36        (eq? (car (cdr exp)) '+)))
37
38 (define (product? exp)
39   (and (pair? exp)
40        (eq? (car (cdr exp)) '*)))
41
42 (define (addend exp) (car exp))
43 (define (augend exp) (car (cdr (cdr exp))))
44
45 (define (multiplicant exp) (car exp))
46 (define (multiplier exp) (car (cdr (cdr exp))))
47
48 ;; test
49 (deriv '(x + (3 * (x + (y + 2)))) 'x)
50 (deriv '(x + (3 * (x + (y + 2)))) 'y)