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