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)) ) )
初期状態のポインタの状態
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)
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)
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#)
(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)
共有とアイデンティティ
(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は、外側の環境へのポインタを持たない
環境とフレーム
- 変数の値とは、環境の中でその変数に対する束縛を含む最初のフレームの中で、与えられる値
- フレームの列の中にその変数の束縛を規定しているものがなければ変数はその環境においてその未束縛
- 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の局所状態はどのようにして共有されるか?
自分の解答
なんか違いそうだった・・・。
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))
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))
自分で考えた答え
なんか色々違うっぽい。。 色々人の解答をみてみたりした。。
Envの考え方がそもそも違ったっぽい
解答verFix