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

2006-05-06

named-letの練習 named-letの練習 - 結城浩のSICP日記 を含むブックマーク

さっき作った以下のコード。

  ; visit a[1]..a[m].
  (define (visit a m)
    (define (iterator k result)
      (cond ((> k m)
              (visit-proc (reverse result)))
            (else
              (iterator (+ k 1) (cons (vector-ref a k) result)))))
    (iterator 1 '()))

named-letを使うと、次のように書き換えられる。

  ; visit a[1]..a[m].
  (define (visit a m)
    (let loop ((k 1) (result '()))
      (cond ((> k m)
              (visit-proc (reverse result)))
            (else
              (loop (+ k 1) (cons (vector-ref a k) result))))))))

整数の分割 整数の分割 - 結城浩のSICP日記 を含むブックマーク

Knuth先生の本に書かれている「整数の分割を生成するアルゴリズム」を、Schemeでコーディングしました。

Visitしている感じを、引数で与えられた手続きの呼び出しで表現してみました♪

また、アルゴリズムの各ステップを別の関数にして、末尾再帰で呼び出しています。

; From "The Art of Computer Programming Volume 4, Fascicle 3,"
; by D. E. Knuth, p.38 (Section 7.2.1.4) Algorithm P
; (Partitions in reverse lexicographic order).
; Coded by hyuki.

(define (generate-partitions n visit-proc)
  ; if b then return 1, else return 0.
  (define (iverson b)
    (cond (b 1)
          (else 0)))

  ; visit a[1]..a[m].
  (define (visit a m)
    (define (iterator k result)
      (cond ((> k m)
              (visit-proc (reverse result)))
            (else
              (iterator (+ k 1) (cons (vector-ref a k) result)))))
    (iterator 1 '()))

  ; P1. [Initialize.]
  (let ((a (make-vector (+ n 1) 0)) (m 1) (q 0) (x 0))
        ; P2. [Store the final part.]
        (define (P2)
          (vector-set! a m n)
          (set! q (- m (iverson (= n 1))))
          (P3))
        ; P3. [Visit.]
        (define (P3)
          (visit a m)
          (cond ((not (= (vector-ref a q) 2)) (P5))
                (else
                  ; P4. [Change 2 to 1+1.]
                  (vector-set! a q 1)
                  (set! q (- q 1))
                  (set! m (+ m 1))
                  (vector-set! a m 1)
                  (P3))))
        ; P5. [Decrease a_q.]
        (define (P5)
          (cond ((not (= q 0))
                  (set! x (- (vector-ref a q) 1))
                  (vector-set! a q x)
                  (set! n (+ (- m q) 1))
                  (set! m (+ q 1))
                  (P6))))
        ; P6. [Copy x if necessary.]
        (define (P6)
          (cond ((<= n x) (P2))
                (else
                  (vector-set! a m x)
                  (set! m (+ m 1))
                  (set! n (- n x))
                  (P6))))
        ; Start.
        (P2)))

(generate-partitions 8 (lambda (x) (print x)))

実行結果です。8を分割しています。

(8)
(7 1)
(6 2)
(6 1 1)
(5 3)
(5 2 1)
(5 1 1 1)
(4 4)
(4 3 1)
(4 2 2)
(4 2 1 1)
(4 1 1 1 1)
(3 3 2)
(3 3 1 1)
(3 2 2 1)
(3 2 1 1 1)
(3 1 1 1 1 1)
(2 2 2 2)
(2 2 2 1 1)
(2 2 1 1 1 1)
(2 1 1 1 1 1 1)
(1 1 1 1 1 1 1 1)

[]p.131:make-monitored p.131:make-monitored - 結城浩のSICP日記 を含むブックマーク

Schemeの勉強はしていたけれど、さっぱりSICPを読んでいなかった (^_^;

ひげぽんさんが問題3.1〜3.6のあたりをやっていたので、私も考えた。

問題3.2:関数をラップして呼び出し回数をカウントする関数make-monitoredを作る。

(define (make-monitored f)
  (define counter 0)
  (lambda (arg)
    (cond ((eq? arg 'how-many-calls?) counter)
          ((eq? arg 'reset-count) (set! counter 0))
          (else
            (set! counter (+ counter 1))
            (f arg)))))

(define s (make-monitored sqrt))

(s 'how-many-calls?)
;=> 0

(s 100)
;=> 10.0

(s 'how-many-calls?)
;=> 1

(s 256)
;=> 16.0

(s 'how-many-calls?)
;=> 2

(s 'reset-count)
;=> 0

(s 'how-many-calls?)
;=> 0

でもこれだと、make-monitoredの引数として与える関数のarityは1に決まってしまうので、たとえば + の回数を数えることはできないはず。

(define (make-monitored f)
  (define counter 0)
  (lambda (arg)
    (cond ((eq? arg 'how-many-calls?) counter)
          ((eq? arg 'reset-count) (set! counter 0))
          (else
            (set! counter (+ counter 1))
            (f arg)))))

(define add (make-monitored +))

(add 1 (add 2 3) (add 4 5 6))
;*** ERROR: wrong number of arguments for #<closure (make-monitored make-monitored)> (required 1, got 2)

なので、修正。

(define (make-monitored f)
  (define counter 0)
  (define (call-it . args)
    (set! counter (+ counter 1))
    (apply f args))
  (lambda args
    (cond ((null? args) (call-it))
          ((eq? (car args) 'how-many-calls?) counter)
          ((eq? (car args) 'reset-count) (set! counter 0))
          (else (apply call-it args)))))

(define add (make-monitored +))

(add 1 (add 2 3) (add 4 5 6))
;=> 21

(add 'how-many-calls?)
;=> 3

よしよし。できたできた。

疑問:任意個引数の関数を呼び出すのには上記のようにapplyを使うしかないのでしょうか。最初、(f . args)などと書いてたくさん怒られました。

と、ここまで書いて、ひげぽんさんの解答を読む。ひげぽんさん、問題3.2でreset-countに対応していませんよう!

named-letとラムダ式 named-letとラムダ式 - 結城浩のSICP日記 を含むブックマーク

なんでもλを読みながら「ローカル変数の束縛と引数の束縛」を考える。

named-letという面白そうなものが紹介されていた。

1から9までを表示するプログラム。

(define (foo)
  (define (bar k limit)
    (cond ((< k limit)
           (print k)
           (bar (+ k 1) limit))))
  (bar 1 10))

(foo)
;1
;2
;3
;4
;5
;6
;7
;8
;9
;=> #<undef>

named-letを使う。

(define (foo)
  (let xxxxx ((k 1) (limit 10))
    (cond ((< k limit)
           (print k)
           (xxxxx (+ k 1) limit)))))

(foo)
;1
;2
;3
;4
;5
;6
;7
;8
;9
;=> #<undef>

上のプログラムは次と等価らしい。

(define (foo)
  (letrec
    ((xxxxx
      (lambda(k limit)
        (cond ((< k limit)
               (print k)
               (xxxxx (+ k 1) limit))))))
    (xxxxx 1 10)))

(foo)
;1
;2
;3
;4
;5
;6
;7
;8
;9
;=> #<undef>

つまりnamed-letで束縛される変数を引数に持つラムダ式を、named-letに書かれた名前にbindする。そして、変数の初期値をラムダ式への最初の引数として与える。ラムダ式に名前が付いているから、再帰呼び出しもできる。ふうん。

追記:脚注3を読み、より正確な形で書き直す。

(define (foo)
  ((letrec
    ((xxxxx
      (lambda(k limit)
        (cond ((< k limit)
               (print k)
               (xxxxx (+ k 1) limit))))))
    xxxxx) 1 10))

(foo)
;1
;2
;3
;4
;5
;6
;7
;8
;9
;=> #<undef>

つまり、(letrec ... xxxxx)とすることで、この部分全体はラムダ式を返し、それに1 10を引数として与えている。中でバインドしたlambda式を外に見せていることになる。

何でもλ 何でもλ - 結城浩のSICP日記 を含むブックマーク

なんでもλを読みながらプログラムを書く。

リストlisとコンテキストctxが与えられて、リストの各要素eに対してeとctxを引数にもつ関数fooを呼ぶ関数barを作る。

普通に再帰。

(define (foo x ctx)
  (display "foo: x = ")
  (display x)
  (display ", ctx = ")
  (display ctx)
  (display "\n"))

(define (bar lis ctx)
  (cond ((not (null? lis))
         (foo (car lis) ctx)
         (bar (cdr lis) ctx))))

(bar '(1 2 3 4 5) 123)
;foo: x = 1, ctx = 123
;foo: x = 2, ctx = 123
;foo: x = 3, ctx = 123
;foo: x = 4, ctx = 123
;foo: x = 5, ctx = 123
;=> #<undef>

for-eachは使えない。ctxがlisと同じ要素数のリストになっていないから。

(define (foo x ctx)
  (display "foo: x = ")
  (display x)
  (display ", ctx = ")
  (display ctx)
  (display "\n"))

(define (bar lis ctx)
  (for-each foo lis ctx))

(bar '(1 2 3 4 5) 123)
;=> #<undef>

へえ、何も表示されないんだ。

先をちらっと見ると「ラムダを使う」解があるらしい。なるほど。「fooを元に、ctxを内部に含んだ一引数関数を作る」のだと見た。

(define (foo x ctx)
  (display "foo: x = ")
  (display x)
  (display ", ctx = ")
  (display ctx)
  (display "\n"))

(define (bar lis ctx)
  (for-each (lambda (lis) (foo lis ctx)) lis))

(bar '(1 2 3 4 5) 123)
;foo: x = 1, ctx = 123
;foo: x = 2, ctx = 123
;foo: x = 3, ctx = 123
;foo: x = 4, ctx = 123
;foo: x = 5, ctx = 123
;=> #<undef>

継続の練習(3) 継続の練習(3) - 結城浩のSICP日記 を含むブックマーク

Scheme:なぜSchemeにはreturnが無いのかを読みながらプログラムを書く。

述語predとリストlisが与えられて、最初に見つかった要素を返す関数findを作る。

(define (find pred lis)
  (cond ((pred (car lis)) (car lis))
        (else (find pred (cdr lis)))))

(define (even? n) (eq? (modulo n 2) 0))

(find even? '(1 3 5 4 2)) ;=> 4

(find even? '(1 3 5 7 9)) ;*** ERROR: pair required, but got ()

しまった。みつからない場合を忘れていた。仕切り直し。

見つからない場合には#fを返すようにした(でもこれだとリスト中に#fがある場合に曖昧さが残るんだけれど…)。

(define (find pred lis)
  (cond ((null? lis) #f)
        ((pred (car lis)) (car lis))
        (else (find pred (cdr lis)))))

(define (even? n) (eq? (modulo n 2) 0))

(find even? '(1 3 5 4 2)) ;=> 4

(find even? '(1 3 5 7 9)) ;=> #f

次はBob-2の例を写経したもの。

(define (find pred lis)
  (call/cc
    (lambda (return)
      (for-each
        (lambda (e) (if (pred e) (return e)))
        lis)
      #f)))

(define (even? n) (eq? (modulo n 2) 0))

(find even? '(1 3 5 4 2)) ;=> 4

(find even? '(1 3 5 7 9)) ;=> #f

その後、カッコの多いClaudeの話を読む。

  • 制御構造に必須な「飛び先」。
  • 飛び先を示すのに特別扱いした構文を導入しない。
  • 飛び先も変数束縛で表現する。束縛するものが継続。
  • 継続は引数に与えたり、戻り値にしたりもできる。

ふむふむ。何でもパラメトライズできるものなんだなあ。

もう一度、Bob-2の例を自分なりに書き直し。

(define (find pred lis)
  (call/cc
    (lambda (return)
      (define (foreach pred lis)
        (cond ((null? lis) (return #f))
              ((pred (car lis)) (return (car lis)))
              (else (foreach pred (cdr lis)))))
      (foreach pred lis))))

(define (even? n) (eq? (modulo n 2) 0))

(find even? '(1 3 5 4 2)) ;=> 4

(find even? '(1 3 5 7 9)) ;=> #f

もっと書き直し。foreachを1レベル外に出して、継続を引数で渡す。

(define (find pred lis)
  (define (foreach pred lis return)
    (cond ((null? lis) (return #f))
          ((pred (car lis)) (return (car lis)))
          (else (foreach pred (cdr lis) return))))
  (call/cc (lambda (return) (foreach pred lis return))))

(define (even? n) (eq? (modulo n 2) 0))

(find even? '(1 3 5 4 2)) ;=> 4

(find even? '(1 3 5 7 9)) ;=> #f

継続の練習(2) 継続の練習(2) - 結城浩のSICP日記 を含むブックマーク

継続とcall/ccを読みながら、ちょっと実験。

(+
  1
  2)
;=> 3

(+
  (call/cc (lambda (cc) 1))
  2)
;=> 3

(+
  (call/cc (lambda (cc) 1))
  (call/cc (lambda (cc) 2)))
;=> 3

((call/cc (lambda (cc) +))
  (call/cc (lambda (cc) 1))
  (call/cc (lambda (cc) 2)))
;=> 3

スペースという「文字」 スペースという「文字」 - 結城浩のSICP日記 を含むブックマーク

R5RSの「文字型」を読んでいます。

#\spaceと書くとスペースという「文字」になります。

(begin
  (display "Hello,")
  (display #\space)
  (display "world!")
  (display #\newline)
  (display "Hello, world!\n"))

実行結果です。

Hello, world!
Hello, world!

higeponhigepon2006/05/06 18:54>reset-countに対応していませんよう!
わあ。本当だ。気づいていませんでした。どもです。

トラックバック - http://sicp.g.hatena.ne.jp/hyuki/20060506