Original Post
Chapter 3 discussions go here.
(define (make-accumulator init) (let ((total init)) (lambda (a) (begin (set! total (+ total a)) total))))(define (make-monitored func) (let ((times-called 0)) (lambda (arg) (if (symbol? arg) (cond ((eq? 'how-many-calls? arg) times-called) ((eq? 'reset-count arg) (set! times-called 0))) (begin (set! times-called (+ times-called 1)) (func arg))))))(define (make-account balance password) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define (dispatch m pass) (if (eq? pass password) (cond ((eq? m 'withdraw) withdraw) ((eq? m 'deposit) deposit) (else (error "Unknown request -- MAKE-ACCOUNT" m))) (begin (print "Incorrect password") () ))) dispatch)(define (make-shared-account account original-pass new-pass) (define (dispatch m pass) (if (eq? pass new-pass) (account m original-pass) "Incorrect password")) dispatch)(define f ;f returns the previous number given to it ;or 0 if it's the first time called (let ((last-x 0)) (lambda (x) (let ((a last-x)) (begin (set! last-x x) a)))))(define (make-accumulator value) (lambda (step) (set! value (+ value step)) value))(define (make-monitored func) (let ((counter 0)) (lambda args (define (call-function) (set! counter (+ 1 counter)) (apply func args)) (if (= (length args) 1) (let ((arg (car args))) (cond ((eq? arg 'how-many-calls?) counter) ((eq? arg 'reset-count) (set! counter 0)) (else (call-function)))) (call-function)))));; (lambda args <body>) accepts any number of arguments;; The arguments are placed in a list bound to the symbol 'args'(define undefined-result (lambda args undefined-result))(define (is-undefined-result? obj) (eq? undefined-result obj))(define (make-vector2d x y) (lambda (arg) (case arg ((x) x) ((y) y))))(define (vector+ u v) (if (or (is-undefined-result? u) (is-undefined-result? v)) undefined-result (make-vector2d (+ (u 'x) (v 'x)) (+ (u 'y) (v 'y))))) (define (vector/ v f) (if (or (is-undefined-result? v) (= f 0)) undefined-result (make-vector2d (/ (v 'x) f) (/ (v 'y) f))))Quote:
Original post by Ezbez
Oh, yes. I have one quick question. I find returning a string when the caller expects a function awkward. The error message produced is unnecessarily long and confusing (complains not just that the password is incorrect but that it's a string, not a function, etc.). Is that just life, or are there some other ways to deal with these types of problems?
>>> Scroll down <<<;; A bit of syntax for testing an expression;; against the expected result.(define-syntax test (syntax-rules () ((test expr result) (let ((actual expr)) (unless (equal? actual result) (display "Failed test: ") (print 'expr) (display " Expected: ") (print 'result) (display " Got: ") (print actual))))));; 3.1(define (make-accumulator value) (define (accumulate addend) (set! value (+ value addend)) value) accumulate)(define A (make-accumulator 5))(test (A 10) 15)(test (A 10) 25);; 3.2(define (make-monitored fn) (let ((calls 0)) (define (monitor . arguments) (case (car arguments) ((how-many-calls?) calls) ((reset!) (set! calls 0)) (else (set! calls (+ calls 1)) (apply fn arguments)))) monitor))(define s (make-monitored sqrt))(test (s 100) 10.0)(test (s 'how-many-calls?) 1);; 3.3(define (make-account balance actual-password) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define (mutter . ignore) "Incorrect password") (define (dispatch password m) (cond ((not (eq? password actual-password)) mutter) ((eq? m 'withdraw) withdraw) ((eq? m 'deposit) deposit) (else (error "Unknown request -- MAKE-ACCOUNT" m)))) dispatch)(define acc (make-account 100 'secret-password))(test ((acc 'secret-password 'withdraw) 40) 60)(test ((acc 'some-other-password 'deposit) 50) "Incorrect password");; 3.4(define (call-the-cops) )(define (make-account balance actual-password) (let ((failures 0)) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define (mutter . ignore) (set! failures (+ failures 1)) (if (< 7 failures) (begin (call-the-cops) "Cops called") "Incorrect password")) (define (dispatch password m) (cond ((or (< 7 failures) (not (eq? password actual-password))) mutter) ((eq? m 'withdraw) withdraw) ((eq? m 'deposit) deposit) (else (error "Unknown request -- MAKE-ACCOUNT" m)))) dispatch))(define acc (make-account 100 'secret-password))(test ((acc 'some-other-password 'withdraw) 40) "Incorrect password")(test ((acc 'some-other-password 'withdraw) 40) "Incorrect password")(test ((acc 'some-other-password 'withdraw) 40) "Incorrect password")(test ((acc 'some-other-password 'withdraw) 40) "Incorrect password")(test ((acc 'some-other-password 'withdraw) 40) "Incorrect password")(test ((acc 'some-other-password 'withdraw) 40) "Incorrect password")(test ((acc 'some-other-password 'withdraw) 40) "Incorrect password")(test ((acc 'some-other-password 'withdraw) 40) "Cops called")(test ((acc 'secret-password 'withdraw) 40) "Cops called");; 3.5;; SRFI-27 provides a random number generator.;; It boggles the mind that a PRNG doesn't come as standard.(use srfi-27)(define (random range) (* (random-real) range))(random-source-randomize! default-random-source)(define (monte-carlo trials experiment) (define (iter trials-remaining trials-passed) (cond ((= trials-remaining 0) (/ trials-passed trials)) ((experiment) (iter (- trials-remaining 1) (+ trials-passed 1))) (else (iter (- trials-remaining 1) trials-passed)))) (iter trials 0))(define (random-in-range low high) (let ((range (- high low))) (+ low (random range))))(define (estimate-integral p x1 x2 y1 y2 trials) (define (experiment) (let ((x (random-in-range x1 x2)) (y (random-in-range y1 y2))) (p x y))) (monte-carlo trials experiment))(define (point-in-circle x y) (>= 1.0 (sqrt (+ (* x x) (* y y)))));; We can't (test) this, since the result is random.(print (* 4.0 (estimate-integral point-in-circle -1 1 -1 1 1000)));; 3.6(define rand (let ((rs (make-random-source))) (lambda (action) (case action ((generate) ((random-source-make-reals rs))) ((reset) (lambda (new-value) (random-source-pseudo-randomize! rs 0 new-value)))))));; 3.7(define (make-joint account old-password new-password) (let ((failures 0)) (define (mutter . ignore) (set! failures (+ failures 1)) (if (< 7 failures) (begin (call-the-cops) "Cops called") "Incorrect password")) (define (dispatch password m) (if (or (< 7 failures) (not (eq? password new-password))) mutter (account old-password m))) dispatch))(define peter-acc (make-account 100 'open-sesame))(define paul-acc (make-joint peter-acc 'open-sesame 'rosebud))(test ((paul-acc 'rosebud 'withdraw) 10) 90);; 3.8(define f (let ((v 1)) (define (f n) (set! v (* v n)) v) f))(print (+ (f 0) (f 1)))Exercise 3.16. Ben Bitdiddle decides to write a procedure to count the number of pairs in any list structure. ``It's easy,'' he reasons. ``The number of pairs in any structure is the number in the car plus the number in the cdr plus one more to count the current pair.'' So Ben writes the following procedure:(define (count-pairs x) (if (not (pair? x)) 0 (+ (count-pairs (car x)) (count-pairs (cdr x)) 1)))Show that this procedure is not correct. In particular, draw box-and-pointer diagrams representing list structures made up of exactly three pairs for which Ben's procedure would return 3; return 4; return 7; never return at all. [source lang='lisp']For 3...(define a (list 'a 'b 'c))simpleFor never returning(define x (list 'a 'b 'c))(set-cdr! (cddr x) x)For 4(define y (list 'a 'b 'c))(set-car! y (cddr y))and for seven...(define v (list 'a 'b 'c))(set-car! (cdr v) (cddr v))(set-car! v (cdr v))Quote:
Original post by GameDev Doctor
Ok, I managed to get to section 3.3 (yay!)
I'm currently on 3.16
*** Source Snippet Removed ***
This one was somewhat confusing, so I'd just like to confirm my answers to see if its what I was supposed to do.
*** Source Snippet Removed ***
;initems? is used for both 3.17 and 3.18(define (initems? x listpart);tests if x is eq? to any pair in a (cond ((null? listpart);list of pairs #f) ((eq? (car listpart) x) #t) (else (initems? x (cdr listpart)))));3.17(define count-pairs (let ((items '())) (define (count x);1 check if x eq? anything in items 2 add stuff (if (or (not (pair? x)) (initems? x items)) 0 (begin (set! items (cons x items)) (+ 1 (count (car x)) (count (cdr x)))))) (lambda (x) (begin (set! items '()) (count x)))));3.18(define (is-cycle? x) (define (test-cycle x sofar) (cond ((initems? x sofar) #t) ((not (pair? x)) #f) (else (test-cycle (cdr x) (cons x sofar))) )) (test-cycle x '()) );3.19(define (cycle? x) (define (cycletest items end distance) (define (cycletest-iter start end distance) (cond ((= distance 0) #f) ((eq? start end) #t) (else (cycletest-iter (cdr start) end (- distance 1))) )) (cond ((not (pair? end)) #f) ((cycletest-iter items end distance) #t) ;one is found in range (else (cycletest items (cdr end) (+ distance 1))) )) (if (not (pair? x)) #f (cycletest x (cdr x) 1)) )Quote:
Original post by GameDev Doctor
Time to get feedback on 3.17 to 3.19, and confirm that my answer to 3.19 is indeed in constant space.
*** Source Snippet Removed ***
The implementation of count-pairs is a bit wierd, with the lambda at the end, but I had trouble making items reset in subsequent calls.
(define (count-pairs x) (let ((items '())) (define (count x) (if (or (not (pair? x)) (initems? x items)) 0 (begin (set! items (cons x items)) (+ 1 (count (car x)) (count (cdr x)))))) (set! items '()) (count x)))(define (some? pred lst) (and (not (null? lst)) (or (pred (car lst)) (some? pred (cdr lst)))))(define (member? item lst) (some? (lambda (x) (eq? x item)) lst))(define (count-pairs lst) (define (count-pairs todo done acc) (if (null? todo) acc (let ((current (car todo)) (rest (cdr todo))) (if (or (not (pair? current)) (member? current done)) (count-pairs rest done acc) (count-pairs (append (list (car current) (cdr current)) (cdr todo)) (cons current done) (+ acc 1)))))) (count-pairs (list lst) () 0))Quote:
Original post by GameDev Doctor
Time to get feedback on 3.17 to 3.19, and confirm that my answer to 3.19 is indeed in constant space.
*** Source Snippet Removed ***
The implementation of count-pairs is a bit wierd, with the lambda at the end, but I had trouble making items reset in subsequent calls.
(define cycle '((a) b c))(set-cdr! (car cycle) cycle) (define (cycle? lst) (define (cycle? lst done) (and (pair? lst) (or (member? (car lst) done) (cycle? (car lst) (cons (car lst) done)) (cycle? (cdr lst) (cons (cdr lst) done))))) (cycle? lst ()))Quote:
Original post by GameDev Doctor
Time to get feedback on 3.17 to 3.19, and confirm that my answer to 3.19 is indeed in constant space.
*** Source Snippet Removed ***
The implementation of count-pairs is a bit wierd, with the lambda at the end, but I had trouble making items reset in subsequent calls.
For 3.19, the algorithm takes increasing chunks of the list, checking if each part of that chunk is eq? to the last member of that chunk until it can verify that the list is or is not a cycle. (it does not, of course, check car, just cdr)
(define (cycle? lst) (define (cycle? x y) (and (pair? x) (pair? (cdr x)) (pair? y) (or (eq? x y) (cycle? (cddr x) (cdr y))))) (cycle? lst (cdr lst)))This topic has been locked by a moderator. New replies are not allowed.
With your permission, GameDev.net uses analytics cookies to understand how people use the platform. You can accept analytics or continue with necessary cookies only. Learn more