diff options
| -rw-r--r-- | ps04_combinators_amb/analyze-amb.scm | 17 | ||||
| -rw-r--r-- | ps04_combinators_amb/bnewbold_ps04.txt | 174 | ||||
| -rw-r--r-- | ps04_combinators_amb/bnewbold_ps04_work.scm | 231 | ||||
| -rw-r--r-- | ps04_combinators_amb/load-amb.scm | 7 | ||||
| -rw-r--r-- | ps04_combinators_amb/load-analyze.scm | 4 | ||||
| -rw-r--r-- | ps04_combinators_amb/multiple-dwelling_edit.scm | 32 | ||||
| -rw-r--r-- | ps04_combinators_amb/repl-amb.scm | 6 |
7 files changed, 462 insertions, 9 deletions
diff --git a/ps04_combinators_amb/analyze-amb.scm b/ps04_combinators_amb/analyze-amb.scm index 5d5ad56..cc98c12 100644 --- a/ps04_combinators_amb/analyze-amb.scm +++ b/ps04_combinators_amb/analyze-amb.scm @@ -2,6 +2,13 @@ ;;; Execution procedures take environment ;;; and two continuations: SUCCEED and FAIL +(define *amb-count* 0) +(define (show-amb-count) + (display "Number of alts considered: ") + (display *amb-count*) + (newline) + (set! *amb-count* 0)) + (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) @@ -187,10 +194,12 @@ (let loop ((alts aprocs)) (if (null? alts) (fail) - ((car alts) env - succeed - (lambda () - (loop (cdr alts))))))))) + (begin + (set! *amb-count* (+ 1 *amb-count*)) + ((car alts) env + succeed + (lambda () + (loop (cdr alts)))))))))) (defhandler analyze analyze-amb amb?) diff --git a/ps04_combinators_amb/bnewbold_ps04.txt b/ps04_combinators_amb/bnewbold_ps04.txt index 0203e57..58d49b1 100644 --- a/ps04_combinators_amb/bnewbold_ps04.txt +++ b/ps04_combinators_amb/bnewbold_ps04.txt @@ -4,15 +4,187 @@ Problem 4.1: Warmup --------------------- +The way I interpreted this question, all the parameters are passed in one list, +as opposed to a finite list of specified parameters plus an arbitrary length +list containing all the "left over" parameters. + Problem 4.2: Infix Notation ----------------------------- +I attacked this problem with the natural language pattern matching technique +described in SICP. First I wrote a crude register-machine-style parser which +turns the infix string into a list which is easier to parse and match over. +Each element in the list is tagged with it's type (eg, number, variable, +open-parenthesis, etc). Then I identified the following types of expressions: + + number: [number] + variable: [variable] + binary: [expression] [oper] [expression] + chunk: [open-paren] [expression] [close-paren] + function: [variable] [open-paren] [expression] [close-paren] + +There's potential for an infinite loop when trying to match an expression +as a binary expression starting with an expression starting with a binary +expression [etc etc], so I defined "simple-expressions" as any of the above +types minus binary, and redefined binary as: + + binary: [simple-expression] [oper] [expression] + +I'm pretty sure this keeps the system general. + +Then I do amb-style pattern matching with requires, and finally "lispify" +the resulting parse tree into an s-expression and evaluate it. + +To do the final evaluation of the parsed code I added this line to +load-amb.scm: + +(define (eval-in-amb exp) + (eval exp generic-evaluation-environment)) + +This doesn't really work the way I want, but the-global-environment apparently +isn't a real environment (?!?!) and I can't get the usual +nearest-repl/environment. Variables defined in the +generic-evaluation-environment are substituted properly into the final +evaluation. Eg: + + ;;; Amb-Eval input: + (define y 10) + + ;;; Starting a new problem + ;;; Amb-Eval value: + Number of alts considered: 0 + y + + ;;; Amb-Eval input: + (infix "y") + + ;;; Starting a new problem + ;Unbound variable: y + +But then, + + 1 ]=> (define x 5) + ;Value: x + + 1 ]=> (go) + + ;;; Amb-Eval input: + (infix "x") + ;;; Starting a new problem + ;;; Amb-Eval value: + Number of alts considered: 4 + 5 -Problem 4.3: Programming with AMB +There are one or two other missing pieces: all operators are binary without the +appropriate precedence, decimal numbers aren't recognized, variables have to +be lowercase, negative numbers don't work (use, eg, 0-45 instead), and operators +are just any string of characters made up of "*+/-^" passed straight through, +so exponentiation doesn't work. + +[see code in bnewbold_ps04_work.scm] + +Problem 4.38 +----------------------------------- +This was only a one line change in the code, remove the line: + + (require (not (= (abs (- fletcher smith)) 1))) + +By trying it in the evaluator, I found 5 possible solutions: + + ((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5)) + ((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3)) + ((baker 1) (cooper 4) (fletcher 2) (miller 5) (smith 3)) + ((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)) + ((baker 3) (cooper 4) (fletcher 2) (miller 5) (smith 1)) + +Problem 4.39 +----------------------------------- +The order matters in that it can change the order that solutions are found, +and definately changes the speed with which they are found. The actual set of +solutions does not change; all solutions will still meet the requirements. + +The given order of the requirements actually does a reasonable job optimizing +for the speed of the search. Putting the most restrictive requirements first +will help reduce the number of checks and backtraces performed, so I would put +the (require (> miller cooper)) first. + +Problem 4.40 ----------------------------------- +There are 5^5=3125 assignments before the distinct requirement and 5!=120 after. +Here's my fast version: +(define (multiple-dwelling-fast) + (let ((fletcher (amb 1 2 3 4 5))) + (require (not (= fletcher 5))) + (require (not (= fletcher 1))) + (let ((cooper (amb 1 2 3 4 5))) + (require (not (= cooper 1))) + (require (not (= (abs (- fletcher cooper)) 1))) + (let ((miller (amb 1 2 3 4 5))) + (require (> miller cooper)) + (let ((smith (amb 1 2 3 4 5))) + (require (not (= (abs (- smith fletcher)) 1))) + (let ((baker (amb 1 2 3 4 5))) + (require (not (= baker 5))) + (require + (distinct (list baker cooper fletcher miller smith))) + (list (list 'baker baker) + (list 'cooper cooper) + (list 'fletcher fletcher) + (list 'miller miller) + (list 'smith smith)))))))) + +Of coure a big help would be simply removing the impossible floors from the amb +statements for individual people; eg because Cooper can't live on the first +floor, just remove 1 from that amb statement. Problem 4.4: Profiling AMB ---------------------------- +My version ("multiple-dwelling-fast") makes 210 alternative attempts, while the +original makes 1840 attempts. + +The changes I made were to analyze-amb.scm: + +(define *amb-count* 0) +(define (show-amb-count) + (display "Number of alts considered: ") + (display *amb-count*) + (newline) + (set! *amb-count* 0)) + +and repl-amb.scm: + +(define (driver-loop) + (define (internal-loop try-again) + (let ((input + (prompt-for-command-expression input-prompt))) + (if (eq? input 'try-again) + (try-again) + (begin + (newline) + (display ";;; Starting a new problem ") + (evaluator + input + (lambda (val next-alternative) + (display output-prompt) + (show-amb-count) ;;;;;;;;; THIS LINE ADDED + (pp val) + (internal-loop next-alternative)) + (lambda () + (display ";;; There are no more values of ") + (pp input) + (driver-loop))))))) + (internal-loop + (lambda () + (display ";;; There is no current problem") + (driver-loop)))) + +#| Example: +eval> (multiple-dwelling) +;;; Starting a new problem +;;; Amb-Eval value: +Number of alts considered: 1840 +((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)) +|# diff --git a/ps04_combinators_amb/bnewbold_ps04_work.scm b/ps04_combinators_amb/bnewbold_ps04_work.scm index e69de29..5bcaf99 100644 --- a/ps04_combinators_amb/bnewbold_ps04_work.scm +++ b/ps04_combinators_amb/bnewbold_ps04_work.scm @@ -0,0 +1,231 @@ +;;; 6.945 Problem Set #4 Source Code +;;; 03/04/2009 +;;; Bryan Newbold <bnewbold@mit.edu> + +; Note: this file is usually loaded from the load-*.scm files into +; the-generic-evaluation-environment + +;--------------------------- +; Problem 4.1 + +#| ; This conflicts with the infix code below, so leave it commented in + ; when testing that code. + +(defhandler execute-application + (lambda (proc args) + ((procedure-body proc) + (if (list? (procedure-parameters proc)) + (extend-environment + (procedure-parameters proc) + args + (procedure-environment proc)) + (extend-environment + (list (procedure-parameters proc)) + (list args) + (procedure-environment proc))))) + compound-procedure?) +|# +#| Testing: + +eval> (define (ss . x) (map square x)) +ok +eval> (ss 1 2 3) +(1 4 9) + +; and the regular syntax still works: + +eval> (define (s2 x y) (list (square x) (square y))) +ok +eval> (s2 1 2 3 4 5) +;Too many arguments supplied (x y) (1 2 3 4 5) +eval> (s2 1 2) +(1 4) +|# + + +;--------------------------- +; Problem 4.2 + +; first we gotta listify the infix string or life will suck +(define (infix-operator? x) + (member x (string->list "+-*^/"))) +(define (infix-open-paren? x) + (member x (string->list "("))) +(define (infix-close-paren? x) + (member x (string->list ")"))) +(define (infix-var? x) + (member x (string->list "abcdefghijklmnopqrstuvwxyz"))) +(define (infix-number? x) + (member x (string->list "0123456789"))) +(define (infix-same-type? a b) + (cond ((infix-operator? a) (infix-operator? b)) + ((infix-open-paren? a) (infix-open-paren? b)) + ((infix-close-paren? a) (infix-close-paren? b)) + ((infix-number? a) (infix-number? b)) + ((infix-var? a) (infix-var? b)) + (else (error "Not a valid infix char type: " a)))) +(define (infix-tag-type x) + (let ((tag (cond ((infix-operator? (car x)) 'oper) + ((infix-open-paren? (car x)) 'open-paren) + ((infix-close-paren? (car x)) 'close-paren) + ((infix-var? (car x)) 'variable) + ((infix-number? (car x)) 'number) + (else (error "Something wrong, not a type: " x))))) + (list tag (list->string (reverse x))))) + +(define (listify in) + (define out '()) + (define prog '()) + (define (work chunk) + (cond ((null? chunk) + (cons (infix-tag-type prog) out)) + ((equal? (car chunk) #\space) + (work (cdr chunk))) + ((null? prog) + (begin + (set! prog (cons (car chunk) prog)) + (work (cdr chunk)))) + ((and (infix-same-type? (car prog) (car chunk)) + (not (or (infix-open-paren? (car prog)) + (infix-close-paren? (car prog))))) + (begin + (set! prog (cons (car chunk) prog)) + (work (cdr chunk)))) + (else + (begin + (set! out (cons (infix-tag-type prog) out)) + (set! prog (list (car chunk))) + (work (cdr chunk)))))) + (reverse (work (string->list in)))) + +#| Test: +(listify "4+34^4-(a*a+b^2)") +;Value: ((number "4") (oper "+") (number "34") (oper "^") (number "4") (oper "-") (open-paren "(") (var "a") (oper "*") (var "a") (oper "+") (var "b") (oper "^") (number "2") (close-paren ")")) + +(listify "4+34^4 - ( a*a + b^2)") +;Value: ((number "4") (oper "+") (number "34") (oper "^") (number "4") (oper "-") (open-paren "(") (var "a") (oper "*") (var "a") (oper "+") (var "b") (oper "^") (number "2") (close-paren ")")) +|# + +; alright, now we can do fun NLP mojo + + +#| These definitions should be pasted into an amb-evaluator: + +(define (require p) + (if (not p) (amb))) + +(define *unparsed* '()) + +(define (parse-type t) + (require (not (null? *unparsed*))) + (require (equal? (caar *unparsed*) t)) + (let ((found-type (car *unparsed*))) + (set! *unparsed* (cdr *unparsed*)) + found-type)) + +(define (parse-binary) + (list 'binary + (parse-simple-expression) + (parse-type 'oper) + (parse-expression))) + +(define (parse-chunk) + (list 'chunk + (parse-type 'open-paren) + (parse-expression) + (parse-type 'close-paren))) + +(define (parse-function) + (list 'function + (parse-type 'variable) + (parse-chunk))) + +(define (parse-simple-expression) + (amb (parse-type 'number) + (parse-type 'variable) + (parse-chunk) + (parse-function))) + +(define (parse-expression) + (amb (parse-type 'number) + (parse-type 'variable) + (parse-binary) + (parse-chunk) + (parse-function))) + +(define (parse-infix in) + (set! *unparsed* (listify in)) + (let ((sent (parse-expression))) + (require (null? *unparsed*)) + sent)) + +#| Test: +;;; Amb-Eval input: +(parse-infix "sqrt(5+square(4*4))") + +;;; Starting a new problem +;;; Amb-Eval value: +Number of alts considered: 99 +(function + (variable "sqrt") + (chunk + (open-paren "(") + (binary + (number "5") + (oper "+") + (function + (variable "square") + (chunk (open-paren "(") + (binary (number "4") (oper "*") (number "4")) + (close-paren ")")))) + (close-paren ")"))) + +;;; Amb-Eval input: +(parse-infix "1+2+4+5") + +;;; Starting a new problem +;;; Amb-Eval value: +Number of alts considered: 13 +(binary + (number "1") + (oper "+") + (binary (number "2") + (oper "+") + (binary (number "4") (oper "+") (number "5")))) + +|# + +(define (lispify parsed) + (cond ((eq? (car parsed) 'function) + (list (lispify (car (cdr parsed))) + (lispify (car (cdr (cdr parsed)))))) + ((eq? (car parsed) 'variable) + (string->symbol (car (cdr parsed)))) + ((eq? (car parsed) 'number) + (string->number (car (cdr parsed)))) + ((eq? (car parsed) 'binary) + (list (lispify (car (cdr (cdr parsed)))) + (lispify (car (cdr parsed))) + (lispify (car (cdr (cdr (cdr parsed))))))) + ((eq? (car parsed) 'chunk) + (lispify (car (cdr (cdr parsed))))) + ((eq? (car parsed) 'oper) + (string->symbol (car (cdr parsed)))) + (else (error "Unhandled type: " (car parsed))))) + +; note, this requres eval-in-amb to be defined in the top level +(define (infix in) + (eval-in-amb (lispify (parse-infix in)))) + +#| +; x needs to be defined in the top level; here it's 5 + +;;; Amb-Eval input: +(infix "sqrt(4+3/x*square(56 - 83))") + +;;; Starting a new problem +;;; Amb-Eval value: +Number of alts considered: 146 +2.0002057507335316 + +|# diff --git a/ps04_combinators_amb/load-amb.scm b/ps04_combinators_amb/load-amb.scm index 6f3d1a8..a2ec775 100644 --- a/ps04_combinators_amb/load-amb.scm +++ b/ps04_combinators_amb/load-amb.scm @@ -7,8 +7,11 @@ (define generic-evaluation-environment (extend-top-level-environment user-initial-environment)) +(define (eval-in-amb exp) + (eval exp generic-evaluation-environment)) + (load "analyze-amb" generic-evaluation-environment) +(load "bnewbold_ps04_work" generic-evaluation-environment) (load "repl-amb" generic-evaluation-environment) - -(ge generic-evaluation-environment)
\ No newline at end of file +(ge generic-evaluation-environment) diff --git a/ps04_combinators_amb/load-analyze.scm b/ps04_combinators_amb/load-analyze.scm index 02e447e..1d274ae 100644 --- a/ps04_combinators_amb/load-analyze.scm +++ b/ps04_combinators_amb/load-analyze.scm @@ -3,11 +3,11 @@ (load "syntax" user-initial-environment) (load "rtdata" user-initial-environment) - (define generic-evaluation-environment (extend-top-level-environment user-initial-environment)) (load "analyze" generic-evaluation-environment) +(load "bnewbold_ps04_work" generic-evaluation-environment) (load "repl" generic-evaluation-environment) -(ge generic-evaluation-environment)
\ No newline at end of file +(ge generic-evaluation-environment) diff --git a/ps04_combinators_amb/multiple-dwelling_edit.scm b/ps04_combinators_amb/multiple-dwelling_edit.scm new file mode 100644 index 0000000..e6ee53d --- /dev/null +++ b/ps04_combinators_amb/multiple-dwelling_edit.scm @@ -0,0 +1,32 @@ + +(define (require p) + (if (not p) (amb))) + +(define (distinct l) + (cond ((null? l) true) + ((null? (cdr l)) true) + ((member (car l) (cdr l)) false) + (else (distinct (cdr l))))) + + +(define (multiple-dwelling-fast) + (let ((fletcher (amb 1 2 3 4 5))) + (require (not (= fletcher 5))) + (require (not (= fletcher 1))) + (let ((cooper (amb 1 2 3 4 5))) + (require (not (= cooper 1))) + (require (not (= (abs (- fletcher cooper)) 1))) + (let ((miller (amb 1 2 3 4 5))) + (require (> miller cooper)) + (let ((smith (amb 1 2 3 4 5))) + (require (not (= (abs (- smith fletcher)) 1))) + (let ((baker (amb 1 2 3 4 5))) + (require (not (= baker 5))) + (require + (distinct (list baker cooper fletcher miller smith))) + (list (list 'baker baker) + (list 'cooper cooper) + (list 'fletcher fletcher) + (list 'miller miller) + (list 'smith smith)))))))) + diff --git a/ps04_combinators_amb/repl-amb.scm b/ps04_combinators_amb/repl-amb.scm index c7b6ccb..90311b0 100644 --- a/ps04_combinators_amb/repl-amb.scm +++ b/ps04_combinators_amb/repl-amb.scm @@ -66,6 +66,7 @@ input (lambda (val next-alternative) (display output-prompt) + (show-amb-count) (pp val) (internal-loop next-alternative)) (lambda () @@ -78,3 +79,8 @@ (driver-loop)))) (define go driver-loop) + + + + + |