(load "util.scm") (display "\nex-3.1 - accumulator\n") (define (make-accumulator value) (define (accumulate new-value) (set! value (+ value new-value)) value) accumulate) (define A (make-accumulator 5)) (assert (A 10) 15) (assert (A 10) 25) (display "\nex-3.2 - monitored calls\n") (define (make-monitored proc) (define count 0) (define (dispatch m) (cond ((eq? m 'how-many-calls?) count) ((eq? m 'reset-count) (set! count 0) count) (else (set! count (inc count)) (proc m)))) dispatch) (define s (make-monitored sqrt)) (assert (s 100) 10) (assert (s 9) 3) (assert (s 'how-many-calls?) 2) (s 'reset-count) (assert (s 'how-many-calls?) 0) (display "\nex-3.3 - account with password\n") (define (make-account balance password) (define invalid-pw-attempts 0) (define passwords (list password)) (define (password-valid? pw) (contains pw passwords)) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define (add-password new-pw) (set! passwords (cons new-pw passwords)) dispatch) (define (incorrect-password value) "Incorrect password") (define (call-the-cops value) "Call the cops!") (define (dispatch pw m) (if (password-valid? pw) (begin (set! invalid-pw-attempts 0) (cond ((eq? m 'withdraw) withdraw) ((eq? m 'deposit) deposit) ((eq? m 'add-pw) add-password) (else (error "Unknown request -- MAKE-ACCOUNT" m)))) (cond ((= invalid-pw-attempts 3) call-the-cops) (else (set! invalid-pw-attempts (inc invalid-pw-attempts)) incorrect-password)))) dispatch) (define acc (make-account 100 'secret-password)) (assert ((acc 'secret-password 'withdraw) 40) 60) (assert ((acc 'some-other-password 'deposit) 50) "Incorrect password") (display "\nex-3.4 - call the cops\n") ((acc 'some-other-password 'deposit) 50) (assert ((acc 'secret-password 'deposit) 50) 110) ((acc 'some-other-password 'deposit) 50) ((acc 'some-other-password 'deposit) 50) ((acc 'some-other-password 'deposit) 50) (assert ((acc 'some-other-password 'deposit) 50) "Call the cops!") (display "\nex-3.5 - pi via integral\n") (define (rand) (random 65536)) (define (estimate-pi trials) (sqrt (/ 6 (monte-carlo trials cesaro-test)))) (define (cesaro-test) (= (gcd (rand) (rand)) 1)) (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)) (display (estimate-pi 1000)) (newline) (define (estimate-integral P x1 x2 y1 y2 trials) (define (area-test) (P (random-in-range x1 (inc x2)) (random-in-range y1 (inc y2)))) (let ((area-rectangle (* (abs (- x2 x1)) (abs (- y2 y1))))) (* area-rectangle (monte-carlo trials area-test)))) (define (p x y) (<= (+ (square (- x 50)) (square (- y 50))) (square 50))) ; I had to use a bigger circle because random-in-range returns integers. If the ; circle is too small the random coordinates lying within and without of the ; circle are skewed. (let ((area-circle (estimate-integral p 0 100 0 100 1000)) (radius-circle 50.)) (let ((pi (/ area-circle (square radius-circle)))) (assert (< pi 3.4) #t) (assert (> pi 3.0) #t))) (display "\nex-3.6 - rand\n") (define (make-rand) (define x 0) (define a 1664525) (define c 1013904223) (define m (expt 2 32)) (define (reset new-x) (set! x new-x)) (define (generate) (set! x (modulo (+ (* a x) c) m)) x) (define (dispatch command) (cond ((eq? command 'reset) reset) ((eq? command 'generate) (generate)) (else (error "Unknown request -- RAND" m)))) dispatch) (define rand (make-rand)) (let ((r3 (rand 'generate)) (r2 (rand 'generate)) (r1 (rand 'generate))) ((rand 'reset) 0) (assert r1 (rand 'generate)) (assert r2 (rand 'generate)) (assert r3 (rand 'generate))) (display "\nex-3.7\n") (define peter-acc (make-account 100 'open-sesame)) (assert ((peter-acc 'open-sesame 'withdraw) 10) 90) (define (make-joint account password additional-password) ((account password 'add-pw) additional-password)) (define paul-acc (make-joint peter-acc 'open-sesame 'rosebud)) (assert ((peter-acc 'open-sesame 'withdraw) 10) 80) (assert ((paul-acc 'rosebud 'withdraw) 10) 70) (display "\nex-3.8\n") (define f (let ((x 'notset)) (lambda (n) (if (eq? x 'notset) (begin (set! x n) 0) x)))) (display (+ (f 0) (f 1))) (newline) (define f (let ((x 'notset)) (lambda (n) (if (eq? x 'notset) (begin (set! x n) 0) x)))) (display (+ (f 1) (f 0))) (newline)