diff options
Diffstat (limited to 'ps04_combinators_amb/bnewbold_ps04_work.scm')
| -rw-r--r-- | ps04_combinators_amb/bnewbold_ps04_work.scm | 231 |
1 files changed, 231 insertions, 0 deletions
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 + +|# |