src/sicp/ch3_1.rkt

   1 #lang racket
   2
   3 ;; 3.1.1
   4 (define balance 100)
   5
   6 (define (withdraw amount)
   7   (if (>= (- balance amount) 0)
   8       (begin
   9         (set! balance (- balance amount))
  10         balance)
  11       (print "insufficient balance")))
  12
  13 (define new-withdraw
  14   (let ((balance 100))
  15     (lambda (amount)
  16       (if (>= (- balance amount) 0)
  17           (begin
  18             (set! balance (- balance amount))
  19             balance)
  20           "insufficient funds"))))
  21
  22 (define (make-withdraw balance)
  23   (lambda (amount)
  24     (if (>= (- balance amount) 0)
  25         (begin
  26           (set! balance (- balance amount))
  27           balance)
  28         "insufficent funds")))
  29
  30 (define w1 (make-withdraw 100))
  31 (define w2 (make-withdraw 200))
  32
  33 (define (make-account balance)
  34   (define (withdraw amount)
  35     (if (>= (- balance amount) 0)
  36         (begin
  37           (set! balance (- balance amount))
  38           balance)
  39         "insufficient funds"))
  40   (define (deposit amount)
  41     (begin
  42       (set! balance (+ balance amount))
  43       balance))
  44   (define (dispatch m)
  45     (cond
  46       ((eq? m 'withdraw) (lambda (amount) (withdraw amount)))
  47       ((eq? m 'deposit) (lambda (amount) (deposit amount)))
  48       (else (error "unknown request -- make-account " m))))
  49   dispatch)
  50
  51 ;; 3.1.2
  52
  53 (define rand
  54   (let ((x rand-init))
  55     (lambda ()
  56       (begin
  57         (set! x (rand-update x))
  58         x))))
  59
  60 ;; monte carlo simulation
  61
  62 (define (estimate-pi trials)
  63   (sqrt (/ 6 (monte-carlo trials cesaro-test))))
  64
  65 (define (cesaro-test)
  66   (= (gcd (rand) (rand)) 1))
  67
  68 (define (monte-carlo trials experiment)
  69   (define (iter trials-remaining trials-passed)
  70     (cond
  71       ((= trials-remaining 0) (/ trials-passed trials))
  72       ((experiment) (iter (- trials-remaining 1) (+ trials-passed 1)))
  73       (else (iter (- trials-remaining 1) trials-passed))))
  74   (iter trials 0))
  75
  76 ;; using rand-update
  77 (define (estimate-pi2 trials)
  78   (sqrt (/ 6 (random-gcd-trials trials random-init))))
  79
  80 (define (random-gcd-trials trials initial-x)
  81   (define (iter trials-remaining trials-passed x)
  82     (let ((x1 (rand-update x)))
  83       (let ((x2 (rand-update x1)))
  84         (cond
  85           ((= trials-ramaining 0) (/ trials-passed trials))
  86           ((= (gcd x1 x2) 1) (iter (- trials-remaining 1)
  87                                    (+ trials-passed 1)
  88                                    x2))
  89           (else (iter (- trials-remaining 1)
  90                       trials-passed
  91                       x2))))))
  92   (iter trials 0 initial-x))