SICP/ex-3_01-08.scm

(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)