3.3.3 テーブルの表現

テーブル表現

(define (lookup key table)
    (let 
        (
            (record (assoc key (cdr table)))
        )
        (if record
            (cdr record)
            #f)
    )
)

; キーチェック
(define (assoc key records)
    (cond 
        ((null? records) #f)
        ((equal? key (caar records)) (car records))
    (else 
        (assoc key (cdr records)))
    )
)

(define (insert! key value table)
    (let 
        (
            (record (assoc key (cdr table)))
        )
        (if record
            (set-cdr! record value)
            (set-cdr! table (cons 
                (cons key value) (cdr table)))
        )
    )
'ok)

(define (make-table) (list '*table*))

使用例

(define table (make-table))
(print (lookup 'hoge table))
;#f
(insert! 'hoge 1 table)
(print (lookup 'hoge table))
;1

Dispatchのスタイルに対応

(define (make-table)
    (let 
        (
            (local-table (list '*table*))
        )
        (define (lookup key-1 key-2)
            (let 
                (
                    (subtable (assoc key-1 (cdr local-table)))
                )
                (if subtable
                    (let 
                        (
                            (record (assoc key-2 (cdr subtable)))
                        )
                        (if record (cdr record) #f))
                #f)
            )
        )
        (define (insert! key-1 key-2 value)
            (let 
                (
                    (subtable (assoc key-1 (cdr local-table)))
                )
                (if subtable
                    (let 
                        (
                            (record (assoc key-2 (cdr subtable)))
                        )
                        (if record
                            (set-cdr! record value)
                            (set-cdr! subtable 
                                (cons (cons key-2 value) (cdr subtable)))
                            )
                        )
                (set-cdr! local-table
                    (cons (list key-1 (cons key-2 value)) (cdr local-table )))
                )
            )
        'ok)
        (define (dispatch m)
            (cond 
                ((eq? m 'lookup-proc) lookup)
                ((eq? m 'insert-proc!) insert!)
            (else (error "Unknown operation: TABLE" m))))
    dispatch)
)

使用例

(define table (make-table))
(print ((table 'lookup-proc) '+ 10))
;#f
((table 'insert-proc!) '+ 10 5)
(print ((table 'lookup-proc) '+ 10))
;5

ex 3.24

;;;;;;;;;;;;;;;;;;;Ex 3.24;;;;;;;;;;;;;;;;;;;;;;
(define (make-table same-key?)
    (let 
        (
            (local-table (list '*table*))
        )
        ; キーチェック
        (define (assoc key records)
            (cond 
                ((null? records) #f)
                ((same-key? key (caar records)) (car records))
            (else 
                (assoc key (cdr records)))
            )
        )
        (define (lookup key-1 key-2)
            (let 
                (
                    (subtable (assoc key-1 (cdr local-table)))
                )
                (if subtable
                    (let 
                        (
                            (record (assoc key-2 (cdr subtable)))
                        )
                        (if record (cdr record) #f))
                #f)
            )
        )
        (define (insert! key-1 key-2 value)
            (let 
                (
                    (subtable (assoc key-1 (cdr local-table)))
                )
                (if subtable
                    (let 
                        (
                            (record (assoc key-2 (cdr subtable)))
                        )
                        (if record
                            (set-cdr! record value)
                            (set-cdr! subtable 
                                (cons (cons key-2 value) (cdr subtable)))
                            )
                        )
                (set-cdr! local-table
                    (cons (list key-1 (cons key-2 value)) (cdr local-table )))
                )
            )
        'ok)

        (define (dispatch m)
            (cond 
                ((eq? m 'lookup-proc) lookup)
                ((eq? m 'insert-proc!) insert!)
            (else (error "Unknown operation: TABLE" m))))
    dispatch)
)

(print "=== Ex 3.24 ===")
(define operation-table (make-table (lambda (x y) (eq? x y))))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

(print (get '+ 10))
;#f
(put '+ 10 5)
(print (get '+ 10))
;5

ex 3.25

ふぉー(;・∀・)

;;;;;;;;;;;;;;;;;;;Ex 3.25;;;;;;;;;;;;;;;;;;;;;;
(define (make-table same-key?)
    (let 
        (
            (local-table (list '*table*))
        )
        ; キーチェック
        (define (assoc key records)
            (cond 
                ((null? records) #f)
                ((same-key? key (caar records)) (car records))
            (else 
                (assoc key (cdr records)))
            )
        )

        (define (lookup key-list)
            (define (iter keys table)
                (let 
                    (
                        (front (car keys))
                        (remain (cdr keys))
                    )
                    (let 
                        (
                            (subtable (assoc front (cdr table)))
                        )
                        (begin
                            (if 
                                subtable
                                (if 
                                    (null? remain)
                                    (cdr subtable)
                                    (iter remain subtable)
                                )
                                #f
                            )
                        )
                    )
                )
                
            )
            (iter key-list local-table)
        )

        (define (insert! key-list value)
            (define (iter keys value table)
                (define front (car keys))
                (define remain (cdr keys))
                (define subtable (assoc front (cdr table)))
                ;(print front " " remain " " subtable)

                ; subtable作る
                (if 
                    (not subtable)
                    ; subtableがない時
                    (set-cdr! table (cons (cons front '()) (cdr table)))
                    'done
                )
                (let 
                    (
                        (record (assoc front (cdr table)))
                    )
                    (begin
                        (if 
                            (null? remain)
                            ; 末端
                            (set-cdr! record value)
                            ; まだkeyがある
                            (iter remain value record)
                        )
                    )
                )
            )
            (iter key-list value local-table)
        'ok)

        (define (print_)
            (define (repeat n str)
                (if (= n 0)
                    str
                    (repeat (- n 1) (string-append str " "))))
            (define (iter i table)

                (if
                    (null? table)
                    #f
                    (let 
                        (
                            (front (car table))
                        )
                        (begin
                            (if 
                                (pair? front)
                                (begin
                                    (print (repeat i " ") "key:" (car front) " values:" (cdr front))
                                    (if 
                                        (pair? (cdr front))
                                        (iter (+ i 1) (cdr front))
                                        'done
                                    )
                                )
                                (print (repeat i " ") "table:" front))
                            (iter i (cdr table))
                        )
                    )
                )
            )
            (iter 0 local-table)
        )

        (define (dispatch m)
            (cond 
                ((eq? m 'lookup-proc) lookup)
                ((eq? m 'insert-proc!) insert!)
                ((eq? m 'print_) print_)
            (else (error "Unknown operation: TABLE" m))))
    dispatch)
)

テスト 

(print "=== Ex 3.25 ===")

(define operation-table (make-table (lambda (x y) (eq? x y))))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))
(define print_ (operation-table 'print_))
(print (get (list '+ 10)) )
;#f
(put (list '+ 10) 5)
(put (list '+ 'a 'b) 3)
(put (list '-) 1)
(print_)
 ;table:*table*
 ;key:- values:1
 ;key:+ values:((a (b . 3)) (10 . 5))
 ; key:a values:((b . 3))
 ;  key:b values:3
 ; key:10 values:5
(print "(get (list '+ 10)): " (get (list '+ 10)))
(print "(get (list '+ 'a 'b)): " (get (list '+ 'a 'b)))
;(get (list '+ 10)): 5
;(get (list '+ 'a 'b)): 3

Ex 3.26

実装難しかったのでschemeじゃなくてpython... n階層のはむずかしすぎたので、1階層のみ。

import copy


class Node:
    def __init__(self, left=None, right=None, key=None, value=None):
        self.key = key
        self.left = left
        self.right = right
        self.value = value

    def is_leaf_node(self):
        return self.value



class BinaryTreeTable:

    def __init__(self):
        self.root = Node()

    def insert(self, key, value):
        def _insert(node, key, value):
            if node.value is None:
                node.key = key
                node.value = value
                return

            if key <= node.key:
                if node.left is None:
                    node.left = Node()
                _insert(node.left, key, value)
                return

            else:
                if node.right is None:
                    node.right = Node()
                _insert(node.right, key, value)
                return

        _insert(self.root, key, value)

    def lookup(self, key):
        def _lookup(node, key):
            if node is None or node.key is None:
                return None
            if node.key == key:
                return node.value
            if key <= node.key:
                return _lookup(node.left, key)
            return _lookup(node.right, key)

        return _lookup(self.root, key)


def ex3_26():
    print('ex3.26')
    btt = BinaryTreeTable()
    btt.insert('d', 0)
    btt.insert('a', 10)
    btt.insert('b', 20)
    btt.insert('c', 30)
    print(btt.lookup('c'))  # 30


if __name__ == '__main__':
    ex3_26()

Ex 3.27

def ex3_27():
    def fib(n, table):
        memo = table.lookup(n)
        if memo:
            return memo
        if n <= 0:
            return 0
        if n == 1:
            return 1
        memo = fib(n - 1, table) + fib(n - 2, table)
        table.insert(n, memo)
        return memo

    btt = BinaryTreeTable()
    print(fib(5, btt))
    print(fib(12, btt))
    print(fib(100, btt))
    # 5
    # 144
    # 354224848179261915075

3.3.2 キューの表現

キューの実装

(define (front-ptr queue) (car queue))
(define (rear-ptr queue) (cdr queue))
(define (set-front-ptr! queue item)
    (set-car! queue item))
(define (set-rear-ptr! queue item)
    (set-cdr! queue item))
(define (empty-queue? queue)
    (null? (front-ptr queue)))
(define (make-queue) (cons '() '()))
(define (front-queue queue)
    (if 
        (empty-queue? queue)
        (error "FRONT called with an empty queue" queue)
        (car (front-ptr queue))))

(define (insert-queue! queue item)
    (let 
        ((new-pair (cons item '())))
        (cond (
            (empty-queue? queue)
            (set-front-ptr! queue new-pair)
            (set-rear-ptr! queue new-pair)
            queue
        )
        (else
            (set-cdr! 
                (rear-ptr queue) new-pair)
                (set-rear-ptr! queue new-pair)
            queue))
    )
)

(define (delete-queue! queue)
    (cond (
        (empty-queue? queue) (error "DELETE! called with an empty queue" queue))
    (else (set-front-ptr! queue (cdr (front-ptr queue)))
queue)))

演習問題

Exercise 3.21

実際のQueueの状態をみるためのprint-queueの実装

二つ目のやつは、O(1)で最後のポインタにアクセスするためにあるやつ

(define q1 (make-queue))
(print q1)
(insert-queue! q1 'a)
(print q1)
(insert-queue! q1 'b)
(print q1)
(delete-queue! q1)
(print q1)
;(())
;((a) a)
;((a b) b)
;((b) b)

(define (print-queue queue)
    (print (front-ptr queue))
)

テスト

(define q1 (make-queue))
(print-queue q1)
(insert-queue! q1 'a)
(print-queue q1)
(insert-queue! q1 'b)
(print-queue q1)
(delete-queue! q1)
(print-queue q1)
;()
;(a)
;(a b)
;(b)

consを使ってキューを表現しているため、 queueオブジェクトをprintすると、先頭ポインタ + 最後のポインタが表示されてしまう。 キューの状態だけみたいのであれば、先頭ポインタからの後続データ構造だけを表示すれば良い。

Exercise 3.22

キューは、ポインタのペアとして表現する以外に、
局所状態を持つ⼿続きとして構築することもできる。
局所状態は通常のリストの先端と終端へのポインタからなる。
make-queue の定義を完成させ、この表現によるキューの演算を実装せよ。
(define (make-queue)
    (let 
        (
            (front-ptr '())
            (rear-ptr '())
        )
    (define (set-front-ptr! item)
        (set! front-ptr item))
    (define (set-rear-ptr! item)
        (set! rear-ptr item))
    (define (empty-queue?)
        (null? front-ptr))
    (define (front-queue)
        (if 
            (empty-queue?)
            (error "FRONT called with an empty queue" queue)
            (car front-ptr))
    )
    (define (insert-queue! item)
        (let 
            ((new-pair (cons item '())))
            (cond (
                (empty-queue?)
                (set-front-ptr! new-pair)
                (set-rear-ptr! new-pair)
            )
            (else
                (set-cdr! rear-ptr new-pair)
                (set-rear-ptr! new-pair)
                queue))
        )
    )
    (define (delete-queue!)
        (cond (
            (empty-queue?)
            (error "DELETE! called with an empty queue" queue))
        (else 
            (set-front-ptr! (cdr front-ptr)))))
    (define (print-queue) (print front-ptr))
    (define (dispatch m)
        (cond 
            ((eq? m 'front-queue) front-queue)
            ((eq? m 'empty-queue?) empty-queue?)
            ((eq? m 'insert-queue!) insert-queue!)
            ((eq? m 'delete-queue!) delete-queue!)
            ((eq? m 'print-queue) print-queue)
        ))
    dispatch))

テスト

(define queue (make-queue))
((queue 'insert-queue!) 'a)
((queue 'print-queue))
((queue 'insert-queue!) 'b)
((queue 'print-queue))
(print ((queue 'front-queue)))

((queue 'delete-queue!))
((queue 'print-queue))
((queue 'delete-queue!))
((queue 'print-queue))
;((queue 'delete-queue!))
;((queue 'print-queue))
;(a)
;(a b)
;a
;(b)
;()
;*** ERROR: DELETE! called with an empty queue #<closure ((make-queue dispatch) m)>
;    While loading "./3.3.2.scm" at line 138
;Stack Trace:

Execise 3.23

両端キュー (deque)(“double-ended queue”) は、先端と終端のどちらに対しても項⽬の挿⼊と削除が⾏える列である。
deque に対する演算は、
コンストラクタ make-deque、述語 empty-deque?、
セレクタ front-deque、rear-deque、
ミューテータ front-insert-deque!,rear-insert-deque!, front-deletedeque!,
rear-delete-deque! である。
ペアによって deque を表現するやり⽅を⽰せ。また、演算を実装せよ。
全ての演算は Θ(1)ステップで完了しなければならない。

Schemeでかく能力がなかったのでPythonで書いた(´・ω・`)

def ex_3_23():
    class Item:
        def __init__(self, value):
            self.value = value
            self.prev = None
            self.next = None

        def __repr__(self):
            return '<Item {}>'.format(self.value)

    class Deque:
        def __init__(self):
            self.front = None
            self.rear = None

        def empty_queue(self):
            return self.front is None

        # Selector
        def front_deque(self):
            return self.front.value

        def rear_deque(self):
            return self.rear.value

        # Mutator
        def front_insert_deque(self, value):
            item = Item(value)
            if self.front:
                item.next = self.front
                self.front.prev = item
            else:
                self.rear = item
            self.front = item

        def rear_insert_deque(self, value):
            item = Item(value)
            if self.rear:
                item.prev = self.rear
                self.rear.next = item
            else:
                self.front = item
            self.rear = item

        def front_delete_queue(self):
            if self.front is None:
                raise Exception('Queue is empty.')
            if self.front is self.rear:
                self.rear = None
            self.front = self.front.next
            if self.front:
                self.front.prev = None

        def rear_delete_queue(self):
            if self.rear is None:
                raise Exception('Queue is empty.')
            if self.front is self.rear:
                self.front = None
            self.rear = self.rear.prev
            if self.rear:
                self.rear.next = None

        def print_queue(self):
            q = self.front
            a = []
            while q is not None:
                a.append(q.value)
                q = q.next
            print(a)

    deque = Deque()
    deque.front_insert_deque(1)
    deque.front_insert_deque(2)
    deque.print_queue()
    # [2, 1]
    deque.rear_insert_deque(3)
    deque.print_queue()
    # [2, 1, 3]
    deque.front_delete_queue()
    deque.print_queue()
    # [1, 3]
    deque.rear_delete_queue()
    deque.print_queue()
    # [1]

    deque.rear_delete_queue()
    # deque.rear_delete_queue()
    # Exception: Queue is empty.


ex_3_23()

3.3.1 可変リスト構造

Exercise 3.12

appendとappend!の挙動の違い

手続きの定義

; xの一番最後の要素にyを付け加える
(define (append x y)
    (if (null? x)
        y
        (cons (car x) (append (cdr x) y))
    )
)

; xの最後の要素をとってきて、そこに追加する
(define (append! x y)
    (set-cdr! (last-pair x) y)
x)

(define (last-pair x)
    (if 
        (null? (cdr x))
        x
        (last-pair (cdr x))
    )
)

初期状態のポインタの状態

f:id:cocodrips:20171030200921j:plain:w300

append実行の挙動

; append
(define x (list 'a 'b))
(define y (list  'c 'd))
(print "x:" x " y:" y)

(define z (append x y))
(print "(append x y) -> " z)

(print "(cdr x) -> " (cdr x))
;x:(a b) y:(c d)
;(append x y) -> (a b c d)
;(cdr x) -> (b)

f:id:cocodrips:20171030213815j:plain:w300

append!実行の挙動

; append!
(define x (list 'a 'b))
(define y (list 'c 'd))
(print "x:" x " y:" y)

(define w (append! x y))
(print "(append! x y) -> " w)
(print "(cdr x) -> " (cdr x))
;x:(a b) y:(c d)
;(append! x y) -> (a b c d)
;(cdr x) -> (b c d)

f:id:cocodrips:20171030200529j:plain:w300

Exercise 3.13

ぐーるぐる

(define (make-cycle x)
    (set-cdr! (last-pair x) x)
x)

(define z (make-cycle (list 'a 'b 'c)))
(print "z" z)
;z#0=(a b c . #0#)

f:id:cocodrips:20171030210823j:plain:w300

(print "(last-pair z) -> " (last-pair z))

とまっちゃうー><

Exercise 3.14

逆まわし

(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)) 
(define w (mystery v)) 

(print "w:" w)
; w:(c b a)

f:id:cocodrips:20171030210817j:plain:w300

共有とアイデンティティ

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

(print (set-to-wow! z1))
;((wow b) wow b)

(print (set-to-wow! z2))
;((wow b) a b)

Exercise 3.15

Exercise 3.16

count-pairs で3,4,7が返るデータ構造をつくる & うまく動かないのはどんなときか。

(define (count-pairs x)
    (if 
        (not (pair? x))
        0
        (+ 
            (count-pairs (car x))
            (count-pairs (cdr x))
            1
        )))

(define x (list 'a 'b))
(define l3 (cons 'a (cons 'b (cons 'c ()))))
(print (count-pairs l3))
;3 

(define l4 (cons 'a (cons 'b x)))
(print (count-pairs l4))
;4

(define l7 (cons 'a (cons 'b (cons x x))))
(print (count-pairs l7))
; 7

(define l_mevius (cons 'a (cons 'b (cons 'c ()))))
(set-cdr! (cdr (cdr l_mevius)) l_mevius)
;#0=(a b c . #0#)
;(print (count-pairs l_mevius))
;... 終了しない

Exercise 3.17

count-pairs ⼿続きの正しいバージョンを考え、任意の構造について区別可能なペアの数を返すようにせよ。(ヒント:カウント済みのペアを記録しておく補助データ構造を維持しながら構造をたどれ)。

(define (count-pairs x)
    (define mem '())
    (define (count x)
        (cond 
            ((not (pair? x)) 0)
            ((memq x mem) 0)
            (else
                (set! mem (cons x mem))
                (+ 
                    (count (car x))
                    (count (cdr x))
                    1
                )))
    )
(count x))


(print (count-pairs l3))
;3
(print (count-pairs l7))
;5
(print (count-pairs l_mevius))
;3

今まで辿ったリストを保持しておく。

Exercise 3.18

リストを検査し、循環を持つかどうか、つまり連続して cdr を取ることによってリストの終端を探そうとするプログラムが無限ループになるかどうかを判定する⼿続きを書け。

(define (has-loop x)
    (define mem '())
    (define (loop-check x)
        (cond 
            ((not (pair? x)) #f)
            ((memq (cdr x) mem) #t)
            (else
                (set! mem (cons (cdr x) mem))
                (loop-check (cdr x)))
    ))
(loop-check x))

(print (has-loop l3))
;#f
(print (has-loop l7))
;#f
(print (has-loop l_mevius))
;#t

cdrだけ辿っていって、自分自身のポインタを持つか探す

3.2 評価の環境モデル

環境とは

  • フレーム (frame) が並んだもの

フレームとは

  • 変数の名前 + 対応する値を結び付ける束縛 (binding)のセット
  • 1つのフレームは任意の変数に対して 0or1 の束縛をもつ
  • 外側の環境へのポインタを持つ
    • ただしglobalは、外側の環境へのポインタを持たない

環境とフレーム

  • 変数の値とは、環境の中でその変数に対する束縛を含む最初のフレームの中で、与えられる値
  • フレームの列の中にその変数の束縛を規定しているものがなければ変数はその環境においてその未束縛

f:id:cocodrips:20170925230652p:plain

  • I, II, III => フレーム
    • x, yが I のフレームに束縛されている
    • x, zが II のフレームに束縛されている
    • m, yが III のフレームに束縛されている
  • A, B, C, D => 環境へのポインタ
    • 環境Bにおいて m=1, y=2, x=3
    • 環境Aにおいて x=7, z = 6, y=5
    • 環境Aにおいて、フレームII のx = 7 が、フレームIのx = 3の束縛を隠蔽している

3.2.4 内部定義

Exercise 3.11

(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)

この手続が、次の対話によって生成される環境構造

(define acc (make-account 50))
((acc 'deposit) 40)
;90
((acc 'withdraw) 60)
;30

また、

(define acc2 (make-account 100))

を定義した時accとacc2の局所状態はどのようにして共有されるか?

自分の解答 f:id:cocodrips:20170925211657j:plain

なんか違いそうだった・・・。

解答ver2

exercise 3.11

(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)

このプログラムが、次の対話によって⽣成される環境構造を⽰せ。

(define acc (make-account 50))
((acc 'deposit) 40)
((acc 'withdraw) 60)
(define acc2 (make-account 100))
  1. 初期状態

  2. (define acc (make-account 50))

  3. ((acc 'deposit) 40)

  4. ((acc 'withdraw) 60)

  5. (define acc2 (make-account 100)) .

3.2.3 局所状態の保管場所としてのフレーム

Exercise 3.10

(let ((⟨var⟩ ⟨exp⟩)) ⟨body⟩) は ((lambda (⟨var⟩) ⟨body⟩) ⟨exp⟩) と解釈される。 その場合を環境モデルを使って説明せよ。

(define W1 (make-withdraw 100))
(W1 50)
(define W2 (make-withdraw 100))

書き換えた場合の処理は

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

自分で考えた答え f:id:cocodrips:20170925195524j:plain

なんか色々違うっぽい。。 色々人の解答をみてみたりした。。

Envの考え方がそもそも違ったっぽい

解答ver2

解答verFix f:id:cocodrips:20171002225647j:plain

参考

Exercise 3.10 – SICP exercises SICP問題3.10 - tmurataの日記