SICP 読み (113) 3.3.3 表の表現

デキるかどうか不明ですが頑張ってみる。

問題 3.26

_二進木を使って組織化する表の実装を述べよ_とあるんですが、insert! なソレはハードル高すぎと見て、とりあえず二進木化したらどんなデータになるか、という事と lookup の実装で胡麻化させて下さひ。
# コメントで insert! も実装せい、等と言われると死ぬ

とりあえず 1 次元でトライ。元にしたのは 3.25 なソレにしたい。最初の試験が以下。

#!/usr/bin/env gosh

(use test.unit)
(require "3.26")

(define-test-suite "3.26"

  ("3.26"
   ("binary tree lookup (1)"
    (let ((t '(*table ((3 . 5) 
		       ((1 . 7) () ((2 . 1) () ()))
		       ((5 . 2) ((4 . 3) () ()) ((6 . 4) () ()))))))
      (assert-equal 7 (lookup 1 t))
      (assert-equal 1 (lookup 2 t))
      (assert-equal 5 (lookup 3 t))
      (assert-equal 3 (lookup 4 t))
      (assert-equal 2 (lookup 5 t))
      (assert-equal 4 (lookup 6 t))
      )
    )
   )

)

key も数値限定にします。現時点の検討では assoc をナニすれば済むと見てるんですがアマイかなぁ。以下がわし的な 2.66 の lookup ッス。

(define (lookup given-key set-of-records)
 (cond ((null? set-of-records) #f)
       ((= given-key (key (entry set-of-records)))
        (value (entry set-of-records)))
       ((< given-key (key (entry set-of-records)))
        (lookup given-key (left-branch set-of-records)))
       (else
        (lookup given-key (right-branch set-of-records)))))

表をナニするためには

表の cdr を上記の lookup に渡す必要あり
entry と left-branch と right-branch と value と key の定義が必要

ってコトでかなり無理矢理ですが、以下

(define (lookup given-key t)
  (define (entry tree) (car tree))
  (define (left-branch tree) (cadr tree))
  (define (right-branch tree) (caddr tree))
  (define (key ent) (car ent))
  (define (value ent) (cdr ent))

  (let ((set-of-records (cdr t)))
    (cond ((null? set-of-records) #f)
	  ((= given-key (key (entry set-of-records)))
	   (value (entry set-of-records)))
	  ((< given-key (key (entry set-of-records)))
	   (lookup given-key (left-branch set-of-records)))
	  (else
	   (lookup given-key (right-branch set-of-records))))))

あ、lookup じゃなくて assoc だな。

不具合

全部サラしてるんで書かざるを得ない。(を

lookup において assoc に (cdr t) を渡している
見落し。let 使って cdr するのを中止
元の assoc との引数の解釈
caar を見て equal? だったら car を戻しているのが 3.25 以前の assoc なので、key は caar で value は cadr で良いか。あとはマッチした時に value ではなくて entry を戻せば良いな。

って駄目。ちょっと落ち着いてよく見てみる事に。マンガを省略してるのが敗因。

む

やっぱマンガ書かなかったのが敗因か。
表の cdr は二進木を指してるセルになる、というのはビンゴなのかなぁ。不具合の原因としては assoc に渡す表でした。一次元では以下の実装で動作したんですが、それ以上の次数でどうなるか、は不明。

(define (assoc given-key set-of-records)
  (define (entry tree) (car tree))
  (define (left-branch tree) (cadr tree))
  (define (right-branch tree) (caddr tree))
  (define (key ent) (car ent))
  (define (value ent) (cdr ent))

  (cond ((null? set-of-records) #f)
	((= given-key (key (entry set-of-records)))
	 (entry set-of-records))
	((< given-key (key (entry set-of-records)))
	 (assoc given-key (left-branch set-of-records)))
	(else
	 (assoc given-key (right-branch set-of-records)))))

(define (lookup keylist local-table)
  (let f ((k keylist) (t local-table))
    (let ((subtable (assoc (car k) (cadr t))))
      (if subtable
	  (if (null? (cdr k))
	      (cdr subtable)
	      (f (cdr k) subtable))
	  #f))))

さらに

で、以下の試験を追加してみた。

   ("binary tree lookup (2)"
    (let ((t '(*table* ((3 ((7 . 8) () ()))
			((1 . 7) () ((2 . 1) () ()))
			((5 . 2) ((4 . 3) () ()) ((6 . 4) () ()))))))
      (assert-equal 7 (lookup '(1) t))
      (assert-equal 1 (lookup '(2) t))
;      (assert-equal 5 (lookup '(3) t))
      (assert-equal 8 (lookup '(3 7) t))
      (assert-equal 3 (lookup '(4) t))
      (assert-equal 2 (lookup '(5) t))
      (assert-equal 4 (lookup '(6) t))
      )
    )

通ったんですが、表に設定されている形式が正しいかどうか微妙。もう少し検証してみたい。

むむ

なんか自分で見てもデータありき、で手続きをそれに合わせて作ってるように見える。ちゃんとマンガ書いてたんですが、あの紙はどこいったんだー。