-
Notifications
You must be signed in to change notification settings - Fork 0
/
2-56.scm
89 lines (74 loc) · 1.9 KB
/
2-56.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
(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)
(make-product
(make-product (exponent exp)
(make-exponentiation (base exp)
(make-sum (exponent exp) -1)))
(deriv (base exp) var)))
(else
(error "unknown expression type -- DERIV" exp))
)
)
(define (variable? e)
(symbol? e)
)
(define (same-variable? e1 e2)
(and (variable? e1) (variable? e2) (eq? e1 e2))
)
(define (sum? e)
(and (pair? e) (eq? (car e) '+)))
(define (addend e)
(cadr e))
(define (augend e)
(caddr e))
(define (number=? exp num)
(and (number? exp) (= exp num)))
(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 (product? e)
(and (pair? e) (eq? (car e) '*)))
(define (multiplier e)
(cadr e))
(define (multiplicand e)
(caddr e))
(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))
)
)
(define (exponentiation? e)
(and (pair? e) (eq? (car e) '**))
)
(define (base e)
(cadr e))
(define (exponent e)
(caddr e))
(define (make-exponentiation b e)
(cond ((number=? b 1) 1)
((number=? b 0) 0)
((number=? e 0) 1)
((number=? e 1) b)
(else (list '** b e))
)
)