結城浩のSICP日記 RSSフィード

2006-05-02

[]汎用DBMインタフェース 汎用DBMインタフェース - 結城浩のSICP日記 を含むブックマーク

Gaucheの汎用DBMインタフェースをdbm.fsdbm(ファイルシステムベース)で使ってみます。

(use dbm)
(use dbm.fsdbm)

(define *db*
  (dbm-open <fsdbm>
    :path "database"
    :rw-mode :write))

(dbm-put! *db* "Alice" "23")
(dbm-put! *db* "Bobby" "18")
(dbm-put! *db* "Chris" "22")

(define alice-age (dbm-get *db* "Alice"))
(print alice-age)
;23

(dbm-for-each *db*
  (lambda (key val)
    (display key)
    (display " => ")
    (display val)
    (newline)))
;Chris => 22
;Bobby => 18
;Alice => 23

(dbm-close *db*)

append append - 結城浩のSICP日記 を含むブックマーク

R5RSの「ペアとリスト」を読んでいます。

appendでは、最後のリストは共有されますが、それ以外のリストは新しく割り当てられます。

(append list...)に関して「The resulting list is always newly allocated, except that it shares structure with the last list argument.」とR5RSには書かれています。

以下、確かめてみましょう。

(define x '(10 20 30))
;=> x

(define y '(40 50 60))
;=> y

(define a (append x y))
;=> a

x
;=> (10 20 30)

y
;=> (40 50 60)

a
;=> (10 20 30 40 50 60)

(set-car! x 11)
;=> #<undef>

x
;=> (11 20 30)

y
;=> (40 50 60)

a
;=> (10 20 30 40 50 60)

(set-car! y 44)
;=> #<undef>

x
;=> (11 20 30)

y
;=> (44 50 60)

a
;=> (10 20 30 44 50 60)

ということは、(append x y)のとき、xはリストでなければなりませんが、yはループになっていてもよいはず。確かめてみましょう。

(define x '(1))
;=> x

(define y '(2))
;=> y

(define a (append x y))
;=> a

(set-cdr! y y)
;=> #<undef>

(define b (append x y))
;=> b

(set-cdr! x x)
;=> #<undef>

(define b (append x y))
;*** ERROR: list required, but got #0=(1 . #0#)

ペアとリスト ペアとリスト - 結城浩のSICP日記 を含むブックマーク

R5RSの「ペアとリスト」を読んでいます。

  • 空のリストはペアではない。それはそうだ。
  • 最後が空のリストではないリストは変則リストと呼ばれる。
(car '())
; *** ERROR: pair required, but got ()

(cdr '())
; *** ERROR: pair required, but got ()

(pair? '())
;=> #f
  • set-cdr!を使うとリストでなくなるものを作れる。
  • リストは長さが有限。
(define x '(1))
;=> x

(list? x)
;=> #t

(set-cdr! x x)
;=> #<undef>

(list? x)
;=> #f

(length x)
;*** ERROR: proper list required, but got #0=(1 . #0#)

not not - 結城浩のSICP日記 を含むブックマーク

R5RSの「論理式」を読んでいます。

(not x)はxが真なら#fを、偽なら#tを返します。

(not #t)
;=> #f

(not #f)
;=> #t

(not '#t)
;=> #f

(not '#f)
;=> #t

(not 0)
;=> #f

(not '())
;=> #f

(not 'nil)
;=> #f

(not (not 0))
;=> #t

[]第4回 第4回 - 結城浩のSICP日記 を含むブックマーク

Scheme演習 第4回の問3を解きました。

  • 前節の環境モデルを、抽象データ型のようにインターフェースを定義して実装する。
  • インターフェース

(make-env)

(define-value! <var> <value> <env>)

(get <var> <env>)

(extend <env> <params> <args>)

  • 実現したい実行例
    • (make-env)
      • 初期環境を返す。初期環境はフレームを一つしか持たない環境である。
    • (define-value! var value env)
      • env の中の最外フレームの変数 var の値を value とする。
      • すでに、最外フレームにその変数が存在するならその値を書き換え、存在しないなら新たに var と value の対応を加える。
      • 返り値は不定でよい。
    • (get var env)
      • env の中から(最外フレームから順に)var の指す値を探す。
      • var と最初に見つかった値のペアを返し、どのフレームにも定義されていない時には #f を返す。
    • (extend env params args):
      • パラメタのリスト(params)と引数のリスト(args)を受けとったら、それらから作られる新しいフレームを env の外に加えた環境を返す。

以下に解答を示します。

(define (make-env) (list '()))
;=> make-env

(define (define-value! var value env)
  (define (overwrite-frame! f)
    (if (null? (cdr f))
        (set-cdr! f (list (cons var value)))
        (if (eq? (caar f) var)
            (set-cdr! (car f) value)
            (overwrite-frame! (cdr f)))))
  (if (null? (car env))
      (set-car! env (list (cons var value)))
      (overwrite-frame! (car env))))
;=> define-value!

(define (get var env)
  (if (null? env)
      #f
      (let ((f (car env)))
           (define (get-from-frame f)
                   (if (null? f)
                       (get var (cdr env))
                       (if (eq? (caar f) var)
                           (car f)
                           (get-from-frame (cdr f)))))
           (get-from-frame f))))
;=> get

(define (extend env params args)
  (define (make-frame params args frame)
    (if (null? params)
        frame
        (make-frame
          (cdr params)
          (cdr args)
          (cons (cons (car params) (car args)) frame))))
  (cons (make-frame params args '()) env))
;=> extend

問題で与えられている実行例を試します。

まず、4.1の再現。

(define init-env (make-env))
;=> init-env

(define-value! 'a 10 init-env)
;=> #<undef>

(get 'a init-env)
;=> (a . 10)

(define-value! 'b 15 init-env)
;=> #<undef>

(get 'b init-env)
;=> (b . 15)

(define-value! 'a 20 init-env)
;=> #<undef>

(get 'b init-env)
;=> (b . 15)

4.2の再現。

(define init-env (make-env))
;=> init-env

(define-value! 'e 0.001 init-env)
;=> #<undef>

(define-value! 'sqrt-newton
      (list '*lambda* '(x k)            ; λ-Closure の簡易的な実装
        '(if (< (abs (- (* x x) k)) e)
             x
             (sqrt-newton (/ (+ x (/ k x)) 2) k))
        init-env)
      init-env)                         ; 作られた時の環境(初期環境)を指す
;=> #<undef>

(define sqrt-newton-env
            (extend init-env '(x k) '(1.0 4))) ; 新しいフレームで拡張
;=> sqrt-newton-env

(get 'x sqrt-newton-env)   ; (* x x)の計算のため
;=> (x . 1.0)

(get 'k sqrt-newton-env)   ; (- (* x x) k)の計算のため
;=> (k . 4)

(get 'e sqrt-newton-env)   ; (< (abs (- (* x x) k)) e)の計算のため
;=> (e . 0.001)

(define-value! 'e 0.1 init-env)
;=> #<undef>

(get 'x sqrt-newton-env)   ; (* x x)の計算のため
;=> (x . 1.0)

(get 'k sqrt-newton-env)   ; (- (* x x) k)の計算のため
;=> (k . 4)

(get 'e sqrt-newton-env)   ; (< (abs (- (* x x) k)) e)の計算のため
;=> (e . 0.1)

4.3の再現。

(define init-env (make-env))
;=> init-env

(define-value! 'x 1 init-env)
;=> #<undef>

(define-value! 'f
      (list '*lambda* '(x)         ; λ-Closure の簡易的な実装
        '(+ x 10)
        init-env)
      init-env)                    ; 作られた時の環境(初期環境)を指す
;=> #<undef>

(define f-env (extend init-env '(x) '(0)))
;=> f-env

(get 'x f-env)                 ; (+ x 10)の計算のため
;=> (x . 0)

(get 'x init-env)
;=> (x . 1)

(define f2-env (extend init-env '(x) '(5)))
;=> f2-env

(get 'x f2-env)                ; (+ x 10)の計算のため
;=> (x . 5)
  • λクロージャがinit-envを取り込んでいるので、init-envをprintしようとすると無限ループになります。
  • make-envの定義で、空の環境を ' ( ( ) ) で作ると失敗します。 (list ' ( ) ) を使って評価のたびに新しいセルを作るようにしないと初期化されません。
  • extendでparamsとargsの個数が合わない場合のチェックをしていません。

[]第3回 第3回 - 結城浩のSICP日記 を含むブックマーク

Scheme演習 第3回の問2, (map proc list)を解きました。

(map proc list)

リストlistの要素一つ一つに対して一引数関数procを適用し、結果をリストにして返す関数。

実行例

> (map (lambda (x) (+ x 1)) (list 1 2 3 4))

(2 3 4 5)

以下の解答では…ええと、ただ解いています。

(define (map proc list)
  (if (null? list) list
      (cons (proc (car list)) (map proc (cdr list)))))
;=> map

(map (lambda (x) (+ x 1)) (list 1 2 3 4))
;=> (2 3 4 5)

[]第2回 第2回 - 結城浩のSICP日記 を含むブックマーク

Scheme演習 第2回の問1を解きました。

fibonacci 関数は次のように定義される。

  • fib(0) = 0
  • fib(1) = 1
  • fib(n) = fib(n - 1) + fib(n - 2) (n >= 2)

この定義をそのまま使って関数 (fib1 n) を作れ。

末尾再帰を使って、n に対して線形の時間で求める関数 (fib2 n) を作れ。その際、ブロック構造を用いて、トップレベルに定義する関数は fib2 のみとせよ。

ふたつのプログラムを同じ引数で実行してみて、時間を比較せよ。さらにその時間の違いの理由について考察せよ。

以下の解答では「考察」は省略しています。また、print-until関数を作って最初の10個の値を表示しています(fib1とfib2の結果が等しくなることを目視するため)。

(define (fib1 n)
  (if (= n 0) 0
      (if (= n 1) 1
          (+ (fib1 (- n 1)) (fib1 (- n 2))))))
;=> fib1

(define (fib2 n)
  (define (fib2-iterator k fk-1 fk)
    (if (= k n) fk
        (fib2-iterator (+ k 1) fk (+ fk fk-1))))
  (if (= n 0) 0
      (if (= n 1) 1
          (fib2-iterator 1 0 1))))
;=> fib2

(define (print-until f n)
  (define (print-until-it k)
    (if (< k n)
        (begin
          (display (f k))
          (display ", ")
          (print-until-it (+ k 1)))))
  (display "; ")
  (print-until-it 0)
  (newline))
;=> print-until

(print-until fib1 10)
; 0, 1, 1, 2, 3, 5, 8, 13, 21, 34,
;=> #<undef>

(print-until fib2 10)
; 0, 1, 1, 2, 3, 5, 8, 13, 21, 34,
;=> #<undef>

(time (fib1 37))
;(time (fib1 37))
; real  12.107
; user  12.108
; sys    0.000
;=> 24157817

(time (fib2 37))
;(time (fib2 37))
; real   0.000
; user   0.000
; sys    0.000
;=> 24157817
  • fib1にあまり大きな引数を与えるととんでもなく時間がかかるので注意が必要です。
  • [k, fib(k-1), fib(k)]の関係から[k+1, fib(k), fib(k-1) + fib(k)]を作り出すのがfib2-iteratorです。
  • fib2-iteratorに「2つ前」を与える必要はありません。
  • nのテストはfib2-iteratorの外部でやっています。
  • fib2を書くのは30分くらいかかってしまいました。最初はnのテストをfib2-iteratorの内部で行い、「2つ前」も与えるようにしていたのですが、どうもうまくいかなくて苦労しました。
  • 考えている途中、頭の中ではfib2-iteratorの引数間の関係を表現したアサーションが重要な役割を果たしていたように思います。つまりポイントポイントでは宣言的に考えていて、一つのアサートから別のアサートに移るためにコードを書く、という感じでしょうか。

[]第1回 第1回 - 結城浩のSICP日記 を含むブックマーク

Scheme演習 第1回の問2を解きました。

5つの整数を引数として受け取り、

そのうち偶数が奇数より多い場合は#tを返し、

奇数が偶数より多い場合は#fを返す述語even>odd?を定義せよ。

当然、いろいろな定義の仕方がある。

(以下の解答では「5つの整数」という制約を外し、「任意個の整数」を受け取ります。また偶数と奇数が同数の場合には#fになります)

(define (even>odd? . ns)
  (define (even? n) (= (modulo n 2) 0))
  (define (even>odd?-iterator evens odds ns)
    (if (null? ns)
        (> evens odds)
        (if (even? (car ns))
            (even>odd?-iterator (+ evens 1) odds (cdr ns))
            (even>odd?-iterator evens (+ odds 1) (cdr ns)))))
  (even>odd?-iterator 0 0 ns))
;=> even>odd?

(even>odd? 1 2 3 4 5)
;=> #f

(even>odd? 2 -3 4 5 -6)
;=> #t

SICPリング SICPリング - 結城浩のSICP日記 を含むブックマーク

id:higeponさんのSICPリングを作りました 参加者募集を読んで、結城も申し込みました。

higeponhigepon2006/05/01 23:55ようこそ。sicpリングへ。
結城さんの参加はとても心強いです。