blob: 4ba24513df66497d0541c32507a0a4e19e3714d5 (
plain)
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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
(define algebra-1
(rule-simplifier
(list
;; Associative law of addition
(rule (+ (? a) (+ (? b) (? c)))
none
(+ (+ (? a) (? b)) (? c)))
;; Commutative law of multiplication
(rule (* (? b) (? a))
(expr<? a b)
(* (? a) (? b)))
;; Distributive law of multiplication over addition
(rule (* (? a) (+ (? b) (? c)))
none
(+ (* (? a) (? b)) (* (? a) (? c))))
)))
(define (expr<? x y)
(cond ((null? x)
(if (null? y) #f #t))
((null? y) #f)
((number? x)
(if (number? y) (< x y) #t))
((number? y) #f)
((symbol? x)
(if (symbol? y) (symbol<? x y) #t))
((symbol? y) #f)
((list? x)
(if (list? y)
(let ((nx (length x)) (ny (length y)))
(cond ((< nx ny) #t)
((> nx ny) #f)
(else
(let lp ((x x) (y y))
(cond ((null? x) #f) ; same
((expr<? (car x) (car y)) #t)
((expr<? (car y) (car x)) #f)
(else (lp (cdr x) (cdr y))))))))))
((list? y) #f)
(else
(error "Unknown expression type -- expr<?"
x y))))
#|
(algebra-1 '(* (+ y (+ z w)) x))
;Value: (+ (+ (* x y) (* x z)) (* w x))
|#
(define algebra-2
(rule-simplifier
(list
;; Sums
(rule (+ (? a)) none (? a))
(rule (+ (?? a) (+ (?? b)))
none
(+ (?? a) (?? b)))
(rule (+ (+ (?? a)) (?? b))
none
(+ (?? a) (?? b)))
(rule (+ (?? a) (? y) (? x) (?? b))
(expr<? x y)
(+ (?? a) (? x) (? y) (?? b)))
;; Products
(rule (* (? a)) none (? a))
(rule (* (?? a) (* (?? b)))
none
(* (?? a) (?? b)))
(rule (* (* (?? a)) (?? b))
none
(* (?? a) (?? b)))
(rule (* (?? a) (? y) (? x) (?? b))
(expr<? x y)
(* (?? a) (? x) (? y) (?? b)))
;; Distributive law
(rule (* (? a) (+ (?? b)))
none
(+ (?? (map (lambda (x) `(* ,a ,x)) b))))
;; Numerical simplifications below
(rule (+ 0 (?? x)) none (+ (?? x)))
(rule (+ (? x number?) (? y number?) (?? z))
none
(+ (? (+ x y)) (?? z)))
(rule (* 0 (?? x)) none 0)
(rule (* 1 (?? x)) none (* (?? x)))
(rule (* (? x number?) (? y number?) (?? z))
none
(* (? (* x y)) (?? z)))
)))
#|
(algebra-2 '(* (+ y (+ z w)) x))
;Value: (+ (* w x) (* x y) (* x z))
(algebra-2 '(+ (* 3 (+ x 1)) -3))
;Value: (* 3 x)
|#
|
