SICP 3.1

3.1

#lang racket
(define (make-accumulator sum)
  (lambda (x)
    (set! sum (+ sum x))
    sum))

(define A (make-accumulator 5))
;test
(A 10)
(A 10)

3.2

#lang racket
(define (make-monitored function)
  (let ((call-count 0))
    (lambda (arg)
      (cond
        ((eq? arg 'how-many-calls?) call-count)
        ((eq? arg 'reset-count) (set! call-count 0))
        (else (set! call-count (+ 1 call-count))
              (function arg))))))

;test

(define s (make-monitored sqrt))
(s 'how-many-calls?)
(s 100)
(s 'how-many-calls?)
(s 100)
(s 'how-many-calls?)
(s 'reset-count)
(s 'how-many-calls?)

3.3

#lang racket
(define (make-account balance real-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 inputed-password msg)
    (if (eq? inputed-password real-password)
        (cond ((eq? msg 'withdraw) withdraw)
              ((eq? msg 'deposit) deposit)
              (else (error "Unknown request -- MAKE-ACCOUNT" msg)))
       (error "Incorrect Password")))
  dispatch)

;test
(define acc (make-account 100 'foo))
((acc 'foo 'withdraw) 40)
((acc 'bar 'deposit) 50)

3.4

仕様

  • 連続7回間違えたら call the Cops
  • 成功したらリセット
#lang racket
(define (make-account balance real-password)
  (define (police amount) "Call the Cops")
  (define (wrong-password amount) "Incorrect Password")
  (let ((count 0)
        (limit 7))
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch inputed-password msg)
    (if (eq? inputed-password real-password)
        (begin
          (set! count 0)
          (cond ((eq? msg 'withdraw) withdraw)
              ((eq? msg 'deposit) deposit)
              (else (error "Unknown request -- MAKE-ACCOUNT" msg))))
        (begin
          (set! count (+ 1 count))
          (if (>= count limit)
              police
              wrong-password))))
    dispatch))

;test
(define acc (make-account 100 'foo))
((acc 'foo 'withdraw) 40)
((acc 'bar 'deposit) 10)
((acc 'foo 'withdraw) 40)
((acc 'bar 'deposit) 10)
((acc 'bar 'deposit) 20)
((acc 'bar 'deposit) 30)
((acc 'bar 'deposit) 40)
((acc 'bar 'deposit) 50)
((acc 'bar 'deposit) 60)
((acc 'bar 'deposit) 70)
((acc 'bar 'deposit) 80)
((acc 'foo 'deposit) 20)
((acc 'bar 'deposit) 10)

3.5

#lang racket
(define (random-in-range low high)
  (let ((range (- high low)))
    (+ low (random range))))

(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 (square x) (* x x))

; モンテカルロの結果と (x1,y1)と(x2,y2)を対角に持つ長方形の積を出力
; p 述語関数
; trials 試行回数
(define (estimate-integral p x1 x2 y1 y2 trials)
  (* (monte-carlo
       trials
       (lambda() (p (random-in-range x1 x2)
                    (random-in-range y1 y2))))
     (* (- x2 x1) (- y2 y1))))

;単位円をテストする関数
(define (circle x y)
   (<= (+ (square x) (square y)) 1))

;中心 (5,5) 半径 5 の円
(define (circle2 x y)
  (<= (+ (square (- x 5)) (square (- y 5))) (square 5)))

; piの見積もり (pi=S/r^2)
; S 円の面積
; r 半径
(define (estimate-pi S r)
  (/ S (square r)))

;test
(estimate-pi
  (estimate-integral circle -1 1 -1 1 1000000)
  1.0)

(estimate-pi
   (estimate-integral circle2 0 10 0 10 1000000)
   5.0)

単位円だと、結果は3近傍になり、3.1よりは大きくならない。

円を少し大きくして 中心 5,5 半径5で試してみると 3.16 となった。

3.6

#lang racket

;lcgによる乱数生成
(define (lcg x)
  (remainder (+ (* x 13) 5) 24))

(define new-rand
  (let ((x 1))
    (define (reset new-seed)
        (begin (set! x new-seed)
               x))
    (define (generate)
      (begin
        (set! x (lcg x))
        x))
    (define (dispatch msg)
      (cond
        ((eq? msg 'reset) reset)
        ((eq? msg 'generate) generate)
        (else (error "Unkown arg"))))
    dispatch))

;test
((new-rand 'reset) 2)
((new-rand 'generate))
((new-rand 'generate))
((new-rand 'generate))
((new-rand 'generate))

(newline)
((new-rand 'reset) 2)
((new-rand 'generate))
((new-rand 'generate))
((new-rand 'generate))
((new-rand 'generate))

3.7

#lang racket
(define (make-account balance real-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 inputed-password msg)
    (if (eq? inputed-password real-password)
        (cond ((eq? msg 'withdraw) withdraw)
              ((eq? msg 'deposit) deposit)
              (else (error "Unknown request -- MAKE-ACCOUNT" msg)))
       (error "Incorrect Password")))
  dispatch)

(define (make-joint account current-pass new-pass)
  (lambda (pass msg)
    (if (eq? pass new-pass)
        (account current-pass msg)
        (error "Incorrect Password"))))

; 最初のアカウント
(define peter-acc (make-account 100 'open-sesame))
; 最初のアカウントを使う
((peter-acc 'open-sesame 'deposit) 10)
; 第2のアカウント
(define paul-acc (make-joint peter-acc 'open-sesame 'rosebud))
; 第2のアカウントを使う
((paul-acc 'rosebud 'withdraw) 100)
; 第2のアカウントを最初のアカウントのPWで使う(失敗する)
((paul-acc 'open-sesame 'withdraw) 100)

3.8

引数が0だと、以降ずっと0を返す関数 f を定義する。

#lang racket

(define f
  (let ((x 1))
    (lambda (arg)
      (begin
        (set! x (* x arg))
        x))))

;right->left
(+ (f 1) (f 0))

;left->right
(+ (f 0) (f 1))