L-99 P70d

たまにはプログラミングの話題でも書きますか。

L-99 の p70 です。p70 は既出なので、「d」を付けました。
(あちこちの問題で間違いがあるような気がします。元は Prolog の問題集なので仕方ないかな。意味がよくわからないものもあります。)

a f g ^ ^ c ^ b d ^ e ^ ^ ^

こんなノード文字列が与えられた時にマルチウェイツリーを作りなさい、という問題。
ハットはバックトラックを表すマークです。

(define ht (make-hash-table 'equal?))
(define p-node nil)

(define (entry node) (car node))
(define (parent node) (cadr node))
(define (child node) (caddr node))
(define (branch node) (cadddr node))

(define (set-p-node! entry) (set! p-node entry))
(define (set-parent! node entry) (set-car! (cdr node) entry))
(define (set-child! node entry) (set-car! (cddr node) entry))
(define (set-branch! node entry) (set-car! (cdddr node) entry))

(define (make-node entry parent child branch)
  (hash-table-put! ht entry (list entry parent child branch))
  (set-p-node! entry))

(define (backtrack)
  (let ((node (hash-table-get ht p-node nil)))
    (if (null? node)
	(error "BACKTRACK ERROR")
	(set-p-node! (parent node)))))

(define (add-branch entry)
  (define (last-branch entry)
    (let ((node (hash-table-get ht entry nil)))
      (if (null? node)
	  p-node
	  (begin
	    (set-p-node! entry)
	    (last-branch (branch node))))))
  (let ((node (hash-table-get ht p-node nil)))
    (if (null? node)
	(error "ADD BRANCH ERROR")
	(begin
	  (last-branch (child node))
	  (let ((child (hash-table-get ht p-node nil)))
	    (make-node entry (parent child) nil nil)
	    (set-branch! child entry))))))

(define (add-child entry parent)
  (let ((node (hash-table-get ht p-node nil)))
    (if (null? node)
	(error "ADD CHILD ERROR")
	(begin
	  (make-node entry parent nil nil)
	  (set-child! node entry)))))

(define (construction-mtree root)
  (define (iter e)
    (let ((node (hash-table-get ht e nil)))
      (if (null? node)
	  nil
	  (append
	   (list (list (entry node) (iter (child node))))
	   (iter (branch node))))))
  (let ((node (hash-table-get ht root nil)))
    (list root (iter (child node)))))

(define (parse-node-string lst)
  (define (iter l p)
    (if (null? l)
	ht
	(begin
	  (cond ((null? p) (make-node (car l) nil nil nil))
		((eq? (car l) '^) (backtrack))
		((eq? p '^) (add-branch (car l)))
		(else (add-child (car l) p)))
	  (iter (cdr l) (car l)))))
  (hash-table-clear! ht)
  (iter lst nil))
  
(define (list->mtree lst)
  (begin
    (parse-node-string lst)
    (construction-mtree (car lst))))

バックトラックは Lisp らしいコードを書いていたのでは出来ない気がしたので、
外部変数使っています。きれいなコードとは言えません。
あと外部変数はアスタリスクで括るのが一般的です。

(define *ht* (make-hash-table 'equal?))
(define *p-node* nil)

みたいに。

バックトラックしないといけないので、
ノード文字列をパースしてノードの情報(リスト)を作ります。
親の情報を持たせるのがポイントです。

(ノードエントリ 親ノード 子ノード ブランチノード)

各ノードを見てみると、

gosh> (define zzz (parse-node-string '(a f g ^ ^ c ^ b d ^ e ^ ^ ^)))
zzz
gosh> (hash-table-get zzz 'a)
(a () f ())
gosh> (hash-table-get zzz 'f)
(f a g c)
gosh> (hash-table-get zzz 'g)
(g f () ())
gosh> (hash-table-get zzz 'c)
(c a () b)
gosh> (hash-table-get zzz 'b)
(b a d ())
gosh> (hash-table-get zzz 'd)
(d b () e)
gosh> (hash-table-get zzz 'e)
(e b () ())

という感じのものをハッシュテーブルに持ちます。
なお、p-node は現在処理中のノードを指し示すポインターもどきです。

これが出来てしまえば後は簡単です。

gosh> (list->mtree '(a f g ^ ^ c ^ b d ^ e ^ ^ ^))
(a ((f ((g ()))) (c ()) (b ((d ()) (e ())))))

という感じでマルチウェイツリーが出来上がりました。
図を書かないとなかなかわかりにくいですが、
p70, p70b それから p70c の問題を解くと、
見ただけでもなんとなくわかるようになるかも？です。

マルチウェイツリー図は紙に書いたのですが、
それをテキストに起こすの面倒くさいので、
誠に勝手ながら省略させていただきました。