diff options
| -rw-r--r-- | ps06_rule_systems/bnewbold_ps06.txt | 2 | ||||
| -rw-r--r-- | 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? +|# + + |