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

2006-05-07

[]トレース トレース - 結城浩のSICP日記 を含むブックマーク

Gaucheには標準でtraceがないようなので、ggc: Gauche Garbage Collection Projectにある木村さんのtraceを使うことにします。ダウンロード後、ggc\trace.scmをshare\gauche\site\lib\ggc\debug\trace.scmにコピーしました。使い方はtrace.scmのはじめに書いてあります。

(use ggc.debug.trace)
(define (flatten-list x)
  (let traverse ((x x)
                 (pre-result '())
                 (cc (lambda (final-result)
                      (reverse final-result))))
    (cond ((null? x)
            (cc pre-result))
          ((pair? x)
            (traverse (car x) pre-result
              (lambda (car-result)
                (traverse (cdr x) car-result
                  (lambda (pair-result)
                    (cc pair-result))))))
          (else
            (cc (cons x pre-result))))))

(untrace)
(trace flatten-list)
(flatten-list '(1 (2 3) (4 (5))))

実行結果です。

0:(flatten-list (1 (2 3) (4 (5))))
1:  (flatten-list 1)
    ->(1)
1:  (flatten-list ((2 3) (4 (5))))
2:    (flatten-list (2 3))
3:      (flatten-list 2)
        ->(2)
3:      (flatten-list (3))
4:        (flatten-list 3)
          ->(3)
4:        (flatten-list ())
          ->()
        ->(3)
      ->(2 3)
2:    (flatten-list ((4 (5))))
3:      (flatten-list (4 (5)))
4:        (flatten-list 4)
          ->(4)
4:        (flatten-list ((5)))
5:          (flatten-list (5))
6:            (flatten-list 5)
              ->(5)
6:            (flatten-list ())
              ->()
            ->(5)
5:          (flatten-list ())
            ->()
          ->(5)
        ->(4 5)
3:      (flatten-list ())
        ->()
      ->(4 5)
    ->(2 3 4 5)
  ->(1 2 3 4 5)
; trace: flatten-list has been called 17 times.

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

リストが与えられたとき、pair?が#fになる要素だけをdepth-firstで集めて一次元のリストにする関数flatten-listを作ってみます。

まず、再帰版。

(define (flatten-list x)
  (cond ((null? x)
          '())
        ((pair? x)
          (append
            (flatten-list (car x))
            (flatten-list (cdr x))))
        (else
          (list x))))

(flatten-list '(1 (2 3) (4 (5 6) 7 (8)) 9))
;=> (1 2 3 4 5 6 7 8 9)

継続渡しスタイル。

  • pre-resultは、ここまでの結果。
  • car-resultは、ここまでの結果+(car x)の結果。
  • pair-resultは、ここまでの結果+(car x)+(cdr x)の結果。
  • final-resultは、最終結果。これは逆順になるので、最後にreverseして帰る。
(define (flatten-list x)
  (define (flatten-list/cps x pre-result cc)
    (cond ((null? x)
            (cc pre-result))
          ((pair? x)
            (flatten-list/cps (car x) pre-result
              (lambda (car-result)
                (flatten-list/cps (cdr x) car-result
                  (lambda (pair-result)
                    (cc pair-result))))))
          (else
            (cc (cons x pre-result)))))
  (flatten-list/cps x '()
    (lambda (final-result)
        (reverse final-result))))

(flatten-list '(1 (2 3) (4 (5 6) 7 (8)) 9))
;=> (1 2 3 4 5 6 7 8 9)

さらに、named-letを使ってみましょう。(最近覚えたばかりなので試したいお年頃♪)

(define (flatten-list x)
  (let traverse ((x x)
                 (pre-result '())
                 (cc (lambda (final-result)
                      (reverse final-result))))
    (cond ((null? x)
            (cc pre-result))
          ((pair? x)
            (traverse (car x) pre-result
              (lambda (car-result)
                (traverse (cdr x) car-result
                  (lambda (pair-result)
                    (cc pair-result))))))
          (else
            (cc (cons x pre-result))))))

(flatten-list '(1 (2 3) (4 (5 6) 7 (8)) 9))
;=> (1 2 3 4 5 6 7 8 9)

let traverse ((x ...) (result ...) ...)と書き始めたとき、頭の中では「関数traverseの引数がx, y, ...」と考えている。

疑問:ところで、これって、call/ccを使っていないのですが「継続」の練習になっているんでしょうか?

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

反復的プロセス、末尾再帰、継続渡しスタイル : torus solutions!を読んで継続の勉強。

例としてあげられていたappend/cps (cpsはcontinuation passing style)を半・写経。

(define (append x y)
  (define (append/cps x y cc)
    (cond ((null? x) (cc y))
          (else
            (append/cps (cdr x) y
              (lambda (z) (cc (cons (car x) z)))))))
  (call/cc
    (lambda (cc) (append/cps x y cc))))

(append '(1 2 3) '(4 5))
;=> (1 2 3 4 5)

(append '(1 2 3 4 5) '())
;=> (1 2 3 4 5)

(append '() '(1 2 3 4 5))
;=> (1 2 3 4 5)

このプログラムでは、はじめにxの側をどんどんcarしていく。carした結果はlambdaの中に封じ込め、各レベルのccにバインドしていく。

xをcdrし続けて最後に'()になったなら、(cc y)で一つ前に保存しておいたlambdaを実行する。その結果、一番最初のxの最後の要素と、yとをconsすることになる。

あとは、先ほどまでで封じ込めていたcarを逆順にconsしていく。で、最後にapplyするccは、call/ccで作られた継続。

…と理解。上のプログラムでは二カ所にlambdaが使われているが、引数がzのlambdaでは、zにconsされるcdr部分のリストが渡される。引数がccのlambdaでは、call/ccによってその場所での「継続」が渡される。

ここまでは理解したけれど、自分でcall/ccが使えるかどうか、まだ自信がない。適当な例題を作ってやってみようと思う。

追記:call/ccしなくてよいことに気づいた。

(define (append x y)
  (define (append/cps x y cc)
    (cond ((null? x) (cc y))
          (else
            (append/cps (cdr x) y
              (lambda (z) (cc (cons (car x) z)))))))
  (append/cps x y
    (lambda (result) result)))

(append '(1 2 3) '(4 5))
;=> (1 2 3 4 5)

(append '(1 2 3 4 5) '())
;=> (1 2 3 4 5)

(append '() '(1 2 3 4 5))
;=> (1 2 3 4 5)

ストリームの練習 ストリームの練習 - 結城浩のSICP日記 を含むブックマーク

SRFI-40: Library of Streamsを読んでストリームの練習。

Gaucheモジュール索引を見ると、srfi-40というモジュールはないようです。その代わりにutil.streamが使えるようです。

まず、forceされるタイミングの確認。

(use util.stream)

; print n, when evaluated.
(define (monitor n)
  (print n)
  n)

(define a stream-null)
(define b (stream-cons (monitor 3) a))
(define c (stream-cons (monitor 2) b))
(define d (stream-cons (monitor 1) c))

(stream-car d)
;1
;=> 1

(stream-cadr d)
;2
;=> 2

(stream-caddr d)
;3
;=> 3

SICP 3.5.1(p.190)のstream-enumerate-intervalの半・写経。

(use util.stream)

(define (stream-enumerate-interval low high)
  (cond ((> low high)
          stream-null)
        (else
          (stream-cons
            low
            (stream-enumerate-interval (+ low 1) high)))))

(define s (stream-enumerate-interval 1000 1000000))
(stream-car s)
;=> 1000

(stream-cadr s)
;=> 1001

(stream-caddr s)
;=> 1002

(stream-cadddr s)
;=> 1003

SICP 3.5.1(p.190)のstream-filterの半・写経。stream-filterはSRFI-40にもあるけれど、再定義。

(define (stream-filter pred? stream)
  (cond ((stream-null? stream)
          stream-null)
        ((pred? (stream-car stream))
          (stream-cons
            (stream-car stream)
            (stream-filter pred?
              (stream-cdr stream))))
        (else
          (stream-filter pred?
            (stream-cdr stream)))))

(define s (stream-enumerate-interval 1000 1000000))
(define evens
  (stream-filter
    (lambda (n) (= (modulo n 2) 0))
    s))
(stream-car evens)
;=> 1000

(stream-cadr evens)
;=> 1002

(stream-caddr evens)
;=> 1004

(stream-cadddr evens)
;=> 1006

forceされた値は内部的にメモ化されているので、非効率ではないはず。

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