SICP 3.3 Modeling with Mutable Data

ノート

第２章で勉強した複合データはコンストラクタとセレクタを定義した。代入がが出来れば状態が変化する複合データも作れる。mutatorの導入。mutableと言う言葉は良く目にするが、オブジェクトの状態を変化させるmutatorと言う言葉はこれまで余り目にする事は無かった。調べてみると多くはないが確かにオブジェクトの内容を変更するメソッドをmutatorと呼ぶ事があるらしい。

3.3.1 Mutable List Structure

set-car!、set-cdr!導入。
get-new-pairはここでは用意出来ないので、consの実装については試せない。

Exercise 3.12

示されたプログラムを実際に動かすと

> (define (append! x y)
    (set-cdr! (last-pair x) y)
    x)
> (define (last-pair x)
    (if (null? (cdr x))
        x
        (last-pair (cdr x))))
> (define x (list 'a 'b))
> (define y (list 'c 'd))
> (define z (append x y))
> z
(a b c d)
> (cdr x)
(b)
> (define w (append! x y))
> w
(a b c d)
> (cdr x)
(b c d)
> 

図解

> (define x (list 'a 'b))

> (define y (list 'c 'd))

> (define z (append x y))
> z
(a b c d)

yには変化は無く、xの部分がコピーされる。ただしシンボルそのものは恐らく共通。

> (cdr x)
(b)

xの指している最初のセルの後ろのポインターの先。なのでセル画一つしか無いリスト。

> (define w (append! x y))
> w
(a b c d)

xの最後のセルを探して、その後ろのポインターを書き換える。結局wはxと同じものを指している。

> (cdr x)
(b c d)
> 

xの指している最初のセルの後ろのポインターの先。今度はbの続きが出来ている。

Exercise 3.13

定義したzを表示してみると：

> (define (make-cycle x)
    (set-cdr! (last-pair x) x)
    x)
> (define z (make-cycle (list 'a 'b 'c)))
> z
#0=(a b c . #0#)
> 

循環リストの表記となる。#0#は#0を参照している。

当然last-pairは返って来ない。

> (last-pair z)
. . user break
> 

Exercise 3.14

解釈すると、

1. xの先頭要素にyを連結する。
2. xの残りのリストを次のxに、yを後ろに連結したxの先頭要素を次のyとする。
3. yの初期値は空リスト

「xの残りのリストを次のxに」により再帰の度にxが短くなり最後には無くなる事が分かる。
「yを後ろに連結したxの先頭要素を次のyとする」→（再帰して）→「xの先頭要素にyを連結する」から、今のxの先頭要素を次のxの後ろに連結する事が分かる。
前の要素を次の要素の後ろに連結するのだからリストの順を逆にするreverseとして機能する事が分かる。ただし存在しているリストの各要素のcdrを破壊して逆向きに連結する。

vは'aをcarに持つセルを指していて、これは変わらない。「'aをcarに持つセル」は最初'bをcarに持つセル以下が連結されていたのでv=(a b c d)であったが、mysteryを呼び出すと「'aをcarに持つセル」の後続はいなくなるのでv=(a)となる。

loopの最後のyは'dをcarに持つセルを指していて、これが関数値として返るのでwは'dをcarに持つセルを指す事になる。'dをcarに持つセルは当初とは逆に'cをcarに持つセルを後続に持つ事になり、以下'aまで逆向きに連結されている。
動作させてみる。

> (define (mystery x)
    (define (loop x y)
      (if (null? x)
          y
          (let ((temp (cdr x)))
            (set-cdr! x y)
            (loop temp x))))
    (loop x '()))
> (define v (list 'a 'b 'c 'd))
> (define w (mystery v))
> v
(a)
> w
(d c b a)
> 

図解して行くと、まず最初にvを定義した状態。

(define v (list 'a 'b 'c 'd))

次にloopを呼び出す。

(loop x '())
↓
(loop x y)

空リストの表現が微妙だが取り敢えず。
xのcdrと同じオブジェクトをtempが指す。

(let ((temp (cdr x)))

xのcdrをyと同じものを指す様に変更。

(set-cdr! x y)

再びloopを呼び出す。tempが指していたものを次はxが指す、xが指していたものを次はyが指す。

(loop temp x)
↓
(loop x y)

(let ((temp (cdr x)))

(set-cdr! x y)

(loop temp x)
↓
(loop x y)

(let ((temp (cdr x)))
(set-cdr! x y)

(loop temp x)
↓
(loop x y)

(let ((temp (cdr x)))
(set-cdr! x y)

ここもちょっと空リストの表現が微妙。

(loop temp x)
↓
(loop x y)

返って来た値をwと定義する。

(if (null? x) y
↓
(define w (mystery v))

ややこしくなった矢印を整理すると

Sharing and identity

共有と同一性（？）。
z1とz2は表示させると同じだが、コンスセルの作られ方が異なる。

> (define x (list 'a 'b))
> (define z1 (cons x x))
> z1
((a b) a b)
> (define z2 (cons (list 'a 'b) (list 'a 'b)))
> z2
((a b) a b)
> 

シンボルそのものは同じであれば一つしか確保されないが、コンスセルは別。
代入が無ければこの二つは区別出来ないが、代入してみるとコンスセルが別である事が分かる。

> (define (set-to-wow! x)
    (set-car! (car x) 'wow)
    x)
> z1
((a b) a b)
> (set-to-wow! z1)
((wow b) wow b)
> z2
((a b) a b)
> (set-to-wow! z2)
((wow b) a b)
> 

eq?で同じオブジェクトか否か調べられる。

> (define x (list 'a 'b))
> (define z1 (cons x x))
> (eq? (car z1) (cdr z1))
#t
> (define z2 (cons (list 'a 'b) (list 'a 'b)))
> (eq? (car z2) (cdr z2))
#f
> 

今後set-car!、set-cdr!を使ってセルを共有するデータ構造を作って行くが、これらの操作は慎重に使わないとデータを壊してしまい、予想外な結果をもたらす。

Exercise 3.15

(define x (list 'a 'b))
(define z1 (cons x x))

(set-to-wow! z1)

(define z2 (cons (list 'a 'b) (list 'a 'b)))

(set-to-wow! z2)

Exercise 3.16

> (count-pairs (list 'a 'b 'c))
3
> (define a (list 'a))
> (define b (cons 'b a))
> (define c (cons a b))
> (count-pairs c)
4
> (define d (cons a a))
> (define e (cons d d))
> (count-pairs e)
7
> 

これらの構造は以下の通り。



（R5RSモードで）最後にbのcdrをcに戻すと

> (set-cdr! b c)
> (count-pairs c)
. . user break
> 

戻って来なくなる。

Exercise 3.17

考え方としては、数えたペアを保存する集合を用意して、ツリーを辿りながら集合に含まれていないセルを登録しながらツリーの末端まで探索して、結果の集合の要素数を数える。

#lang r5rs
(define (count-pairs x)
  (define (collect p counted)
    (cond ((not (pair? p)) counted)
          ((memq p counted) counted)
          (else (let ((c (cons p counted)))
                  (let ((d (collect (car p) c)))
                    (collect (cdr p) d))))))
  (length (collect x '())))

実行結果

> (count-pairs (list 'a 'b 'c))
3
> (define a (list 'a))
> (define b (cons 'b a))
> (define c (cons a b))
> c
(mcons (mcons 'a '()) (mcons 'b (mcons 'a '())))
> (count-pairs c)
3
> (define d (cons a a))
> (define e (cons d d))
> e
(mcons (mcons (mcons 'a '()) (mcons 'a '())) (mcons (mcons 'a '()) (mcons 'a '())))
> (count-pairs e)
3
> (set-cdr! b c)
> c
#0=(mcons (mcons 'a '()) (mcons 'b #0#))
> (count-pairs c)
3
> 

循環した場合それ以降は辿らないのでちゃんと返って来る。

Exercise 3.18

循環を検出する。単にオブジェクトをシェアしているのとは異なる。また当初木構造のどこかにループがあればtrueと解釈していたが、どうもcdrを辿って行った時に無限ループになる事を検出するとの事なので、car側の先にループがあっても関係無いとの解釈が正しそう。
なのでそれまでに辿ったセルをリストに入れながらcdr側を下降して行き、既に訪れたセルを見つけたら即trueを返す。

(define (has-cycle? x)
    (define (find-cycle p visited)
      (cond ((not (pair? p)) #f)
            ((memq p visited) #t)
            (else 
             (find-cycle (cdr p) (cons p visited)))))
    (find-cycle x '()))

動作確認

> (has-cycle? (list 'a 'b 'c))
#f
> (define a (list 'a))
> (define b (cons 'b a))
> (define c (cons a b))
> (has-cycle? c)
#f
> (set-cdr! b c)
> (has-cycle? c)
#t
> (has-cycle? (list 'a 'b (make-cycle '(1 2 3 4)) 'c))
#f
> (has-cycle? (make-cycle '(1 2 3 4)))
#t
> (has-cycle? (cons 1 (cons 2 (make-cycle (list 3 4 5 6 7 8)))))
#t
> 

Exercise 3.19

木構造ではなく一列のリストでループを検出する。消費するリソースはリストの長さに関わらず一定。
先頭のセルを出発点にcdrを辿って戻って来なければ一段cdrに移動して…と考えたがループが自分よりも先に戻っている場合は永久に戻って来ない。調べてみると『フロイドの循環検出法]』と言うのがあるらしい。確かにどこかで見た事がある様な。リストを一つずつ進むポインタと二つずつ進むポインタを使う。循環がある場合二つずつ進むポインタがどこかで一つずつ進むポインタに追いつく。追いつくまでにはループを何周かしているかも知れない。本来のアルゴリズムはどこが循環しているのか検出するが、ここでは二つのポインタが同じ場所を指していればループがある事が確定するのでそれで良い。
この方法であれば通り過ぎたセルを記録しておく必要は無い。再帰はするけど末尾再帰の最適化が行われればスタックも消費しない。

(define (has-cycle? x)
  (define (two-more-elements? a)
    (cond ((null? (cdr a)) #f)
          ((null? (cddr a)) #f)
          (else
           #t)))
  (define (floyd turtle rabit)
    (cond ((eq? turtle rabit) #t)
          ((two-more-elements? rabit) (floyd (cdr turtle) (cddr rabit)))
          (else
           #f)))
  (if (two-more-elements? x)
      (floyd (cdr x) (cddr x))
      #f))

実行結果

> (has-cycle? (list 1))
#f
> (has-cycle? (make-cycle (list 1)))
#t
> (has-cycle? (cons 1 (make-cycle (list 2))))
#t
> (has-cycle? (list 1 2))
#f
> (has-cycle? (make-cycle (list 1 2)))
#t
> (has-cycle? (cons 1 (cons 2 (make-cycle (list 3 4)))))
#t
> (has-cycle? (list 1 2 (make-cycle (list 3 4))))
#f
> (has-cycle? (list 1 2 (make-cycle (list 3 4 5 6 7 8))))
#f
> (has-cycle? (cons 1 (cons 2 (make-cycle (list 3 4 5 6 7 8)))))
#t
> 

Mutation is just assignment

変化とは代入の事。

Racketモードで例をそのまま動かせる。

> (define x (cons 1 2))
> (car x)
1
> (cdr x)
2
> (set-car! x 3)
#<procedure:dispatch>
> (car x)
3
> (cdr x)
2
> (set-cdr! x 4)
#<procedure:dispatch>
> (car x)
3
> (cdr x)
4
> 

Exercise 3.20

実行すると

> (define x (cons 1 2))
> (define z (cons x x))
> (set-car! (cdr z) 17)
#<procedure:dispatch>
> (car x)
17
> 

図解すると

(define x (cons 1 2))

(define z (cons x x))

ここで

(set-car! (cdr z) 17)

とすると