From fa1a6fb95704fa8fd739407de2ff93fd25bfe767 Mon Sep 17 00:00:00 2001
From: bnewbold <bnewbold@eta.mit.edu>
Date: Fri, 20 Mar 2009 18:38:51 -0400
Subject: ps06 as submitted

---
 ps06_rule_systems/bnewbold_ps06.txt      |   2 +
 ps06_rule_systems/bnewbold_ps06_work.scm | 150 ++++++++++++++++++++++++++++++-
 2 files changed, 150 insertions(+), 2 deletions(-)

diff --git a/ps06_rule_systems/bnewbold_ps06.txt b/ps06_rule_systems/bnewbold_ps06.txt
index 95273a4..72e135e 100644
--- a/ps06_rule_systems/bnewbold_ps06.txt
+++ b/ps06_rule_systems/bnewbold_ps06.txt
@@ -36,3 +36,5 @@ Problem 6.4: Collect Terms
 Problem 6.5: A Memoizer
 -------------------------------
 
+[see code and comments in bnewbold_ps06_work.scm]
+
diff --git a/ps06_rule_systems/bnewbold_ps06_work.scm b/ps06_rule_systems/bnewbold_ps06_work.scm
index 4358ccf..18e8bfe 100644
--- a/ps06_rule_systems/bnewbold_ps06_work.scm
+++ b/ps06_rule_systems/bnewbold_ps06_work.scm
@@ -1,5 +1,8 @@
+;;; 6.945 Problem Set #6 Source Code
+;;; 03/11/2009
+;;; Bryan Newbold <bnewbold@mit.edu>
 
-(load "load")
+;(load "load")
 
 ;;; Problem 6.4
 
@@ -120,4 +123,147 @@
 
 |#
 
-;;; Problem 6.5
\ No newline at end of file
+;;; Problem 6.5
+
+; note: I commented out the rule-memoize line from "load.scm" so I can define
+; that procedure here then reload the algebra stuff
+
+(define *memoize-table* '())
+
+; this will make a lazy table with n elements
+(define (make-table n)
+  (define (recurse n)
+    (cond ((zero? n) '())
+	  (else (cons '() (recurse (- n 1))))))
+  (cons '*finite-table* (recurse n)))
+
+(define (bring-to-front! x y table)
+  (set-cdr! table
+	    (cons (list x y) 
+		  (list-transform-negative 
+		      (cdr table)
+		    (lambda (element)
+		      (and (not (null? element))
+			   (equal? x (car element))))))))
+
+(define (insert! x y table)
+  (set-cdr! table
+	    (cons (list x y) 
+		  (except-last-pair (cdr table)))))
+
+(define (lookup x table)
+  (define (recurse list)
+    (cond ((null? list) '())
+	  ((null? (car list)) '())
+	  ((equal? x (car (car list))) 
+	   (let ((res (car (cdr (car list)))))
+	     (bring-to-front! x res table)
+	     res))
+	  (else (recurse (cdr list)))))
+  (recurse (cdr table)))
+
+#| Test
+(define tt (make-table 6))
+(insert! 'asdf 3 tt)
+(insert! '(+ 1 2) #f tt)
+tt
+;Value 21: (*finite-table ((+ 1 2) #f) (asdf 3) ())
+(lookup 'asdf tt)
+; 3
+tt
+;Value 27: (*finite-table (asdf 3) ((+ 1 2) #f) () () () ())
+(lookup 'wacky tt)
+; '()
+(lookup '(+ 1 2) tt)
+; #f
+
+|#
+
+(set! *memoize-table* (make-table 25))
+
+(define (rule-memoize f)
+  (lambda (expr)
+    (let ((table *memoize-table*))
+      (let ((last-result (lookup expr table)))
+	(cond
+	 ((null? last-result)
+	  (let ((this-result (f expr)))
+	    (insert! expr this-result table)
+	    this-result))
+	 (else last-result))))))
+
+#| TEST IT OUT!
+
+(pp (algebra-2 '(+ x x x)))
+; (+ x x x)
+
+(algebra-2 '(+ 4 5 (* 3 4) x))
+; (+ 21 x)
+
+(algebra-2 '(* 34 8 (+ 4 5 (* 3 4) x) x))
+
+|#
+
+; but as noted in SICP this isn't really what we want, we need to 
+; override rule-simplifier so simplify-expression calls 
+; (rule-memoize simplified-expression). Otherwise we're only memoizing
+; the application of entire expressions, not recursively through the
+; subexpressions which is where this gets useful.
+
+(define (rule-simplifier the-rules)
+  (define memo-simplify-expression
+    (rule-memoize
+     (lambda (expression)
+       (let ((ssubs
+	      (if (list? expression)
+		  (map memo-simplify-expression expression)
+		  expression)))
+	 (let ((result (try-rules ssubs the-rules)))
+	   (if result
+	       (memo-simplify-expression result)
+	       ssubs))))))
+  memo-simplify-expression)
+
+(load "rules")
+
+#| TEST IT OUT!
+
+(pp (algebra-2 '(+ x x x)))
+; (+ x x x)
+
+(algebra-2 '(+ 4 5 (* 3 4) x))
+; (+ 21 x)
+
+(algebra-2 '(* 34 8 (+ 4 5 (* 3 4) x) x))
+;Value 13: (* 272 x (+ 21 x))
+
+*memoize-table*
+;Value 12: (*finite-table* 
+((* 34 8 (+ 4 5 (* 3 4) x) x) (* 272 x (+ 21 x))) 
+((+ 4 5 (* 3 4) x) (+ 21 x)) 
+((+ x x x) (+ x x x)) 
+((* 8 34 (+ 21 x) x) (* 272 x (+ 21 x))) 
+((* 8 34 x (+ 21 x)) (* 272 x (+ 21 x))) 
+((* 272 x (+ 21 x)) (* 272 x (+ 21 x))) 
+((+ 21 x) (+ 21 x)) 
+(x x) 
+(272 272) 
+(* *) 
+(34 34) 
+(8 8) 
+(+ +) 
+((+ 9 12 x) (+ 21 x)) 
+(21 21) 
+(12 12) 
+(9 9) 
+((* 3 4) 12) 
+((* 12) 12) 
+(4 4) 
+(3 3) 
+(5 5) 
+() () ())
+
+; hmmmm, maybe don't want to memoize /every/ little thing?
+|#
+
+
-- 
cgit v1.2.3