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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
(define variable? symbol?)
(define (same-variable? a b)
(and (variable? a)
(variable? b)
(eq? a b)))
(define (sum-exp? exp)
(and (pair? exp)
(eq? (car exp) '+)))
(define (product-exp? exp)
(and (pair? exp)
(eq? (car exp) '*)))
(define (expon-exp? exp)
(and (pair? exp)
(eq? (car exp )'**)))
(define (** x n)
(exp (* n (log x))))
(define (make-sum lst)
(let ((num (foldl + 0 (filter number? lst)))
(sym (filter (lambda (x) (not (number? x))) lst)))
(if (= 0 num)
(cond ((= (length sym) 0) 0)
((= (length sym) 1) (car sym))
(else (cons '+ sym)))
(if (= (length sym) 0)
num
(cons '+ (cons num sym))))))
;(make-sum '(0 0))
;(make-sum '(2 -2 3 -3 a b))
;(make-sum '(2 3))
;(make-sum '(2 -2 3 a 4 b))
;(make-sum '((+ a b) (+ b d)))
;(make-sum '((* a 0) (* 1 (+ 0 b x))))
;(make-sum '( (* a b) ) )
;(make-sum '(a b) )
(define (make-product lst)
(let ((num (foldl * 1 (filter number? lst)))
(sym (filter (lambda (x) (not (number? x))) lst)))
(cond ((= num 0) 0)
((= num 1) (if (= (length sym) 1)
(car sym)
(cons '* sym)))
(else (cons '* (cons num sym)))
)))
;(make-product '(0 1 2))
;(make-product '(0 a b 1 c))
;(make-product '(0.5 2 a))
;(make-product '(0.5 2 a c (+ a c)))
;(make-product '(a b 1 3 -1 (* f va)))
(define (make-expon x n)
(cond ((eq? n 0) 1)
((eq? x 0) 0)
(else (list '** x n))
))
;(make-expon 0 'a)
;(make-expon 0 0)
;(make-expon 'a 0)
;(make-expon 'a 'b)
;(make-expon 2 3)
(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp var)
1
0))
((sum-exp? exp)
(make-sum
(map
(lambda (x) (deriv x var))
(cdr exp))))
((product-exp? exp)
(let ((first (cadr exp))
(second (make-product (cddr exp))))
(make-sum (list
(make-product (list first (deriv second var)))
(make-product (list (deriv first var) second ))))
))
((expon-exp? exp)
(let ((base (cadr exp))
(n (caddr exp)))
(make-product (list n
(make-expon base (make-sum (list n -1)))
(deriv base var) ))
))
))
(deriv '(+ a (+ a a) b a) 'a) ;4
(deriv 'a 'b) ;0
(deriv '(* a b x) 'a) ;(* b x)
(deriv '(* (+ (* a b) (* a c)) d) 'a) ;(* (+ b c) d)
(deriv '(* (+ a b c) (* a b b)) 'a) ;(+ (* (+ a b c) (* b b)) (* a b b))
(deriv '(** x n) 'x) ;(* n (** x (+ -1 n)))
(deriv '(** (* 3 a ) n) 'a) ;(* n (** (* 3 a) (+ -1 n)) (* 3))
|