summaryrefslogtreecommitdiffstats
path: root/ps06_rule_systems/bnewbold_ps06_work.scm
diff options
context:
space:
mode:
Diffstat (limited to 'ps06_rule_systems/bnewbold_ps06_work.scm')
-rw-r--r--ps06_rule_systems/bnewbold_ps06_work.scm123
1 files changed, 123 insertions, 0 deletions
diff --git a/ps06_rule_systems/bnewbold_ps06_work.scm b/ps06_rule_systems/bnewbold_ps06_work.scm
new file mode 100644
index 0000000..4358ccf
--- /dev/null
+++ b/ps06_rule_systems/bnewbold_ps06_work.scm
@@ -0,0 +1,123 @@
+
+(load "load")
+
+;;; Problem 6.4
+
+(define algebra-3
+ (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)))
+
+ ;; Collect terms
+
+ (rule (+ (?? s) (? x) (? x) (?? e))
+ none
+ (+ (?? s) (* 2 (? x)) (?? e)))
+
+ (rule (+ (?? s) (* (?? x)) (* (?? x)) (?? e))
+ none
+ (+ (?? s) (* 2 (?? x)) (?? e)))
+
+ (rule (+ (?? s) (? x) (?? m) (* (? n number?) (? x)) (?? e))
+ none
+ (+ (?? s) (?? m) (* (? (+ 1 n)) (? x)) (?? e)))
+
+ (rule (+ (?? s) (* (? n number?) (?? x)) (* (? p number?) (?? x)) (?? e))
+ none
+ (+ (?? s) (* (? (+ n p)) (? x)) (?? e)))
+
+ )))
+
+#| Test!
+
+(algebra-3 '(+ x (* 4 x)))
+;Value 15: (* 5 x)
+
+(algebra-3 '(+ (* 8 1 f 34) (* 3 f)))
+;Value 16: (* 275 x)
+
+(algebra-3 '(+ x x))
+;Value 42: (* 2 x)
+
+(algebra-3 '(+ 4 s u s p))
+;Value 39: (+ 4 p u (* 2 s))
+
+(algebra-3 '(+ 1 2))
+;Value: 3
+
+(algebra-3 '(+ (* -2 h) (* 2 h)))
+;Value: 0
+
+(algebra-3 '(+ h (* 4 h)))
+;Value 83: (* 5 h)
+
+(algebra-3 '(+ (* w h) (* 4 h)))
+;Value 84: (+ (* 4 h) (* h w))
+
+(algebra-3 '(+ (* -1 h) (* 2 h)))
+;Value 85: (h)
+
+(algebra-3 '(+ x (* a x)))
+;Value 86: (+ x (* a x))
+
+(algebra-3 '(+ y (* x -2 w) (* x 4 y) (* w x) z (* 5 z) (* x w) (* x y 3)))
+;Value 87: (+ y (* 6 z) (* 7 (x y)))
+
+|#
+
+;;; Problem 6.5 \ No newline at end of file