sicp 3章 問題3.4 まで。2013-05-13 担当分。

q3.1.scm

; 初期値を受け取り、それを内包し、あとは
; "常に「足す数」を渡すと内包されている総数に足すlambda"
; を作って返せばよい

(define (make-accumulator total)
  (lambda (addends)
    (set! total (+ total addends))
    total))

(use gauche.test)
(define A (make-accumulator 5))
(test-start "make-accumulator")
(test* "sum" 15 (A 10))
(test* "sum again" 25 (A 10))
(test-end)

q3.2.scm

; make-monitoredにはfという手続きを渡す
;
; fをcallした回数はcall-countという変数に入れることにして、
; 'how-many-calls? を使って呼び出されるまでは、ひたすら
; 1. call-count に 1 を加えてcall-countにsetする
; 2. fをcallする
; という一連の流れを処理すれば良い

(define (make-monitored f)
  (let ((call-count 0))
    (lambda (param)
      (cond ((eq? param 'how-many-calls?) call-count)
            ((eq? param 'reset-count) (set! call-count 0))
            (else (begin (set! call-count (+ call-count 1))
                         (f param)))))))

(use gauche.test)
(define s (make-monitored sqrt))
(test-start "make-monitored")
(test* "can call s?" 10 (s 100))
(test* "is store call-count?" 1 (s 'how-many-calls?))

(s 'reset-count)
(test* "can reset count?" 0 (s 'how-many-calls?))
(test-end)

q3.3.scm

; 必要なこと
; - 初めに受け取ったpasswordを保持できる
;   - make-accountしたときにpasswordは局所変数として保持できるので特に実装必要なさそう
; - 保持したpasswordと、account利用時の鍵を毎回比較して正しいかどうかを判断する
;   - withdrawやdepositに渡す前に判断した方が楽ですよね -> dispatchの初めで処理しちゃおう

(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 (dispatch key m)
    (if (not (eq? key password))
      (error "Incorrect password"))
    (cond ((eq? m 'withdraw) withdraw)
          ((eq? m 'deposit) deposit)
          (else (error "Unknown request -- MAKE-ACCOUNT"
                       m))))
  dispatch)


(use gauche.test)
(define acc (make-account 100 'secret-password))
(test-start "make-account")
(test* "can use correct password?" 60 ((acc 'secret-password 'withdraw) 40))
(test* "can use incorrect password?" (test-error) ((acc 'some-other-password 'deposit) 50))
(test-end)

q3.4.scm

; 必要なこと
; - q3.3 では "Incorrect password" を error で出しちゃってたので処理続けられるようにただの文字列にしよう
; - "Incorrect password" というエラーを出した回数を覚えておく
;   - そんな問題を q3.2 でやりました
;       -> と思ったけどparamとか考えるの面倒だから再実装しよう
;       -> と思ったが、"Incorrect password"を文字列にしたからamountを受け取るprocedureにした方がいいか
;       -> まぁそれならやっぱりq3.2を利用してみよう
; - 「連続7回」がしきい値なので、correct passwordになったら0回に戻さないと

(load "./q3.2.scm")

(define (call-the-cops)
  error "I place you under arrest!!")

(define (make-account balance password)
  (define (output-error amount)
    "Incorrect password")
  (define (withdraw amount)
    (if (>= balance amount)
      (begin (set! balance (- balance amount))
             balance)
      "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (let ((threshold 7)
        (monitored-output-error (make-monitored output-error)))
    (define (dispatch key m)
      (if (not (eq? key password))
        (if (>= (monitored-output-error 'how-many-calls?) threshold)
          (call-the-cops)
          monitored-output-error)
        (begin
          (monitored-output-error 'reset-count)
          (cond ((eq? m 'withdraw) withdraw)
                ((eq? m 'deposit) deposit)
                (else (error "Unknown request -- MAKE-ACCOUNT"
                             m))))))
    dispatch))


(use gauche.test)
(test-start "make-account")

; procedure for make-account test
(define (sevent-times-incorrect-call f)
  (define (call-iter remainder)
    (if (not (eq? remainder 0))
      (begin
        ((f 'some-other-password 'withdraw) 10)
        (call-iter (- remainder 1)))))
  (call-iter 7))

(test-section "case: more than seven consecutive times with an incorrect password")
(define acc (make-account 100 'secret-password))
(sevent-times-incorrect-call acc)
(test* "can call call-the-cops?" (test-error) ((acc 'some-other-password 'withdraw) 10))

(test-section "case: correct password after seven consecutive times with an incorrect password")
(define acc (make-account 100 'secret-password))
(sevent-times-incorrect-call acc)
(define amount 10)
(define balance ((acc 'secret-password 'withdraw) amount)) ; correct password
(test* "can not call call-the-cops?" "Incorrect password" ((acc 'some-other-password 'withdraw) amount))
(test* "can withdraw with correct password" (- balance amount) ((acc 'secret-password 'withdraw) amount))

(test-end)

s3.1.1_make-account.scm

(define (make-account balance)
  (define (withdraw amount)
    (if (>= balance amount)
      (begin (set! balance (- balance amount))
             balance)
      "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch m)
    (cond ((eq? m 'withdraw) withdraw)
          ((eq? m 'deposit) deposit)
          (else (error "Unknown request -- MAKE-ACCOUNT"
                       m))))
  dispatch)

(use gauche.test)

(define acc (make-account 100))
(test-start "make-account")
(test* "withdraw" 50 ((acc 'withdraw) 50))
(test* "withdraw error" "Insufficient funds" ((acc 'withdraw) 60))
(test* "deposit" 90 ((acc 'deposit) 40))
(test* "withdraw again" 30 ((acc 'withdraw) 60))
(test-end)

s3.1.1_make-withdraw.scm

(define (make-withdraw balance)
  (lambda (amount)
    (if (>= balance amount)
      (begin (set! balance (- balance amount))
             balance)
      "Insufficient funds")))

(use gauche.test)
(define W1 (make-withdraw 100))
(define W2 (make-withdraw 100))
(test-start "make-withdraw")
(test* "W1" 50 (W1 50))
(test* "W2" 30 (W2 70))
(test* "W2 error" "Insufficient funds" (W2 40))
(test* "W1 more" 10 (W1 40))
(test-end)