Permalink
Browse files

bringing in assignment

  • Loading branch information...
1 parent 76fde8c commit d1d61f07a43acb53e24e027427533ae69a975123 @sarabander committed Nov 11, 2011
Showing with 442 additions and 0 deletions.
  1. +15 −0 3.1/3.01.scm
  2. +38 −0 3.1/3.02.scm
  3. +32 −0 3.1/3.03.scm
  4. +52 −0 3.1/3.04.scm
  5. +160 −0 3.1/3.05.scm
  6. +22 −0 3.1/3.06.scm
  7. +103 −0 3.1/3.07.scm
  8. +20 −0 3.1/3.08.scm
View
@@ -0,0 +1,15 @@
+
+(define (make-accumulator initial-value)
+ (let ((acc initial-value))
+ (λ (added)
+ (set! acc (+ acc added))
+ acc)))
+
+(define A (make-accumulator 5))
+
+(A 10) ; 15
+(A 10) ; 25
+
+(A -20) ; 5
+(A -10) ; -5
+(A -10) ; -15
View
@@ -0,0 +1,38 @@
+
+(define (make-monitored f)
+ (let ((counter 0))
+ (define (dispatch message)
+ (cond ((eq? message 'how-many-calls?)
+ counter)
+ ((eq? message 'reset-count)
+ (set! counter 0)
+ counter)
+ (else (set! counter (add1 counter))
+ (f message))))
+ dispatch))
+
+(define s (make-monitored sqrt))
+
+(s 'how-many-calls?) ; 0
+(s 'how-many-calls?) ; 0
+
+(s 169) ; 13
+
+(s 'how-many-calls?) ; 1
+(s 'how-many-calls?) ; 1
+
+(s 49) ; 7
+
+(s 'how-many-calls?) ; 2
+(s 'reset-count) ; 0
+(s 'how-many-calls?) ; 0
+
+(s 10) ; 3.1622776601683795
+
+(s 'how-many-calls?) ; 1
+
+(s 4) ; 2
+(s 25) ; 5
+(s 625) ; 25
+
+(s 'how-many-calls?) ; 4
View
@@ -0,0 +1,32 @@
+
+(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 (block-access amount)
+ "Incorrect password")
+ (define (dispatch secret m)
+ (if (not (eq? secret password))
+ block-access
+ (cond ((eq? m 'withdraw) withdraw)
+ ((eq? m 'deposit) deposit)
+ (else (error "Unknown request - MAKE-ACCOUNT"
+ m)))))
+ dispatch)
+
+(define acc (make-account 100 'secret-password))
+
+((acc 'secret-password 'withdraw) 40) ; 60
+((acc 'secret-password 'withdraw) 40) ; 20
+((acc 'some-other-password 'deposit) 50) ; "Incorrect password"
+((acc 'secret-password 'withdraw) 25) ; "Insufficient funds"
+((acc 'secret-password 'withdraw) 10) ; 10
+((acc '45136 'deposit) 100) ; "Incorrect password"
+((acc 'secret-password 'deposit) 100) ; 110
+((acc 'secret-password 'deposit) 50) ; 160
+((acc 'secret-password 'withdraw) 250) ; "Insufficient funds"
View
@@ -0,0 +1,52 @@
+
+(define (make-account balance password)
+ (let ((password-failures 0))
+ (define (withdraw amount)
+ (set! password-failures 0)
+ (if (>= balance amount)
+ (begin (set! balance (- balance amount))
+ balance)
+ "Insufficient funds"))
+ (define (deposit amount)
+ (set! password-failures 0)
+ (set! balance (+ balance amount))
+ balance)
+ (define (block-access amount)
+ (set! password-failures (add1 password-failures))
+ (if (> password-failures 7)
+ (call-the-cops)
+ "Incorrect password"))
+ (define (call-the-cops)
+ "Calling the police... Run!")
+ (define (dispatch secret m)
+ (cond ((not (eq? secret password)) block-access)
+ ((eq? m 'withdraw) withdraw)
+ ((eq? m 'deposit) deposit)
+ (else (error "Unknown request - MAKE-ACCOUNT"
+ m))))
+ dispatch))
+
+(define acc (make-account 100 'secret-password))
+
+((acc 'secret-password 'withdraw) 40) ; 60
+((acc '45136 'withdraw) 100) ; "Incorrect password"
+((acc '01295 'withdraw) 100) ; (same in between)
+((acc 'palmtree 'withdraw) 100)
+((acc 'electric 'withdraw) 100)
+((acc 'something 'withdraw) 100)
+((acc '36012 'withdraw) 100)
+((acc '010203 'withdraw) 100) ; "Incorrect password"
+;; (7th failure)
+
+((acc 'secret-password 'deposit) 30) ; 90
+;; (resets failure counter)
+
+((acc '45136 'withdraw) 100) ; "Incorrect password"
+((acc '01295 'withdraw) 100) ; (same in between)
+((acc '9754 'withdraw) 100)
+((acc 'whatelse 'withdraw) 100)
+((acc 'palmtree 'withdraw) 100)
+((acc 'electric 'withdraw) 100)
+((acc 'something 'withdraw) 100) ; "Incorrect password"
+((acc '36012 'withdraw) 100) ; "Calling the police... Run!"
+;; (8th failure)
View
@@ -0,0 +1,160 @@
+
+;; Works in MIT-Scheme
+
+(define rand
+ (lambda ()
+ (random 1000)
+ ))
+
+(rand)
+
+(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))
+
+(estimate-pi 1000) ;Value: 3.108349360801046
+(estimate-pi 10000) ;Value: 3.151267458316272
+(estimate-pi 1000000) ;Value: 3.1410504473251293
+
+;; -------------------------------------
+
+(define (random-in-range low high)
+ (let ((range (- high low)))
+ (+ low (random range))))
+
+(random-in-range 0.1 0.9)
+
+(define (make-point x y)
+ (list x y))
+
+(define (x-point point)
+ (car point))
+
+(define (y-point point)
+ (cadr point))
+
+(define (point-in-region? point region)
+ (region point))
+
+(define disk1 (lambda (point)
+ (let ((x (x-point point))
+ (y (y-point point)))
+ (<= (+ (square (- x 5)) (square (- y 7)))
+ (square 3)))))
+
+(point-in-region? (make-point 5 7) disk1) ; true
+(point-in-region? (make-point 2 4) disk1) ; false
+(point-in-region? (make-point 8 10) disk1) ; false
+
+(define disk2 (lambda (point)
+ (let ((x (x-point point))
+ (y (y-point point))
+ (x-center 0)
+ (y-center 0)
+ (radius 1))
+ (<= (+ (square (- x x-center))
+ (square (- y y-center)))
+ (square radius)))))
+
+(point-in-region? (make-point 0 0) disk2) ; true
+(point-in-region? (make-point 0 1) disk2) ; true
+(point-in-region? (make-point 0 1.1) disk2) ; false
+(point-in-region? (make-point 1 1) disk2) ; false
+
+;; Rectangles
+
+;; lower-left and upper-right are points (x, y)
+(define (make-rectangle lower-left upper-right)
+ (cons lower-left upper-right))
+(define (lower-left rectangle)
+ (car rectangle))
+(define (upper-right rectangle)
+ (cdr rectangle))
+(define (x-lower rectangle)
+ (x-point (lower-left rectangle)))
+(define (x-upper rectangle)
+ (x-point (upper-right rectangle)))
+(define (y-lower rectangle)
+ (y-point (lower-left rectangle)))
+(define (y-upper rectangle)
+ (y-point (upper-right rectangle)))
+(define (width rectangle)
+ (- (x-upper rectangle)
+ (x-lower rectangle)))
+(define (height rectangle)
+ (- (y-upper rectangle)
+ (y-lower rectangle)))
+(define (area rectangle)
+ (* (width rectangle)
+ (height rectangle)))
+
+(define rect1 (make-rectangle (make-point 2 4)
+ (make-point 8 10)))
+
+(x-lower rect1) ; 2
+(x-upper rect1) ; 8
+(y-lower rect1) ; 4
+(y-upper rect1) ; 10
+
+(define rect2 (make-rectangle (make-point -1.0 -1.0)
+ (make-point 1.0 1.0)))
+
+(x-lower rect2) ; -1
+(x-upper rect2) ; 1
+(y-lower rect2) ; -1
+(y-upper rect2) ; 1
+
+(define (random-point-in-rectangle rectangle)
+ (make-point (random-in-range (x-lower rectangle)
+ (x-upper rectangle))
+ (random-in-range (y-lower rectangle)
+ (y-upper rectangle))))
+
+(random-point-in-rectangle rect1) ; (4 7)
+
+(random-point-in-rectangle rect2)
+;Value 48: (.6318383337433833 -.9600126255480919)
+
+(define (disk-hit-test disk rectangle)
+ (point-in-region?
+ (random-point-in-rectangle rectangle)
+ disk))
+
+;; (define (disk2-testshoot)
+;; (disk-hit-test disk2 rect2))
+
+(define (estimate-integral region-predicate rectangle trials)
+ (let ((test (lambda () (disk-hit-test region-predicate
+ rectangle))))
+ (let ((hitfraction (monte-carlo trials test)))
+ (* hitfraction (area rectangle)))))
+
+(define (pi-estimation trials)
+ (estimate-integral disk2 rect2 trials))
+
+(pi-estimation 1000) ;Value: 3.184
+(pi-estimation 1000) ;Value: 3.068
+
+(pi-estimation 100000) ;Value: 3.13788
+(pi-estimation 100000) ;Value: 3.14764
+
+(pi-estimation 1000000) ;Value: 3.140216
+(pi-estimation 1000000) ;Value: 3.142132
+
+(pi-estimation 10000000) ;Value: 3.1425508
+(pi-estimation 10000000) ;Value: 3.1423884
+(pi-estimation 10000000) ;Value: 3.1411892
View
@@ -0,0 +1,22 @@
+
+;; Original rand introduced in the text
+(define rand
+ (let ((x random-init))
+ (lambda ()
+ (set! x (rand-update x))
+ x)))
+
+;; New version listening to two messages
+(define rand
+ (let ((x random-init))
+ (define (dispatch message)
+ (cond ((eq? message 'generate)
+ (set! x (rand-update x))
+ x)
+ ((eq? message 'reset)
+ (lambda (new)
+ (set! x new)
+ (set! x (rand-update x))
+ x))
+ (else (error "Message not understood:" message))))
+ dispatch))
Oops, something went wrong.

0 comments on commit d1d61f0

Please sign in to comment.