木を見える化してみた

shinhさんの「木ぽいののループ検出」(http://shinh.skr.jp/m/?date=20081202#p01)の木の構造をgraphvizで表示させてみました。

(gen-tree 2)の場合です。2の場合でこんなに複雑だと、木そのものが指数関数的に増えているような気がします。共有されているところは、何度も辿らないようにして速度向上が図れるかもしれないなと思います。

プログラムです。(tree-graph 表示させたい木)とすると、tree.dotというファイルがカレントディレクトリにできるので、これをdotに食わせると、グラフができます。

(define (output-graph nodetab)
  (with-output-to-file "tree.dot" 
    (lambda ()
      (format #t "digraph G {")
      (let ((no 0)
	    (pair2no (make-hash-table)))
	(hash-table-for-each 
	 nodetab 
	 (lambda (from tos)
	   (let ((fromno (cond ((hash-table-get pair2no from #f)
				(hash-table-get pair2no from))
			       (else
				(inc! no 1)
				(hash-table-put! pair2no from no)
				no))))
	     (map (lambda (to)
		    (cond
		     ((pair? to)
		      (let ((tono (cond ((hash-table-get pair2no to #f)
					 (hash-table-get pair2no to))
					(else
					 (inc! no 1)
					 (hash-table-put! pair2no to no)
					 no))))
			(format #t "\"node~s\" -> \"node~s\"\n" fromno tono)))
		     (else
		      (format #t "\"node~s\" -> \"~s\"\n" fromno to))))
		  tos)))))
    (format #t "}"))))

				 

(define (traverse-tree parent tree nodetab)
  (hash-table-push! nodetab parent tree)
  (cond
   ((hash-table-get nodetab tree #f))
   ((pair? tree)
    (traverse-tree tree (car tree) nodetab)
    (traverse-tree tree (cdr tree) nodetab))))

(define (tree-graph tree)
  (let ((nodetab (make-hash-table)))
    (traverse-tree :top tree nodetab)
    (output-graph nodetab)))
 
;(tree-graph '(a b (c)))   
(tree-graph (gen-tree 2))

追記

ノード数を数えるプログラムが動きました。fujita-yさんの結果と一致しているので正しいんじゃないかなと思います。

(5 3)
(47 8)
(499 15)
(6479 24)
(100841 35)
(1835007 48)
(38263751 63)
(899999999 80)
(23579476909 99)
(681091006463 120)
(21505924728443 143)
(737020860878847 168)
(27246730957031249 195)
(1080863910568919039 224)
(45798768824157052687 255)
(2064472028642102280191 288)
(98646963440126439346901 323)
(4980735999999999999999999 360)
(264969932806620522511615619 399)
(14814019472414484928366903295 440)

左が共有を重複して数えた場合、右が共有を重複しない場合です。右側はO(N^2)になっていると思います。

(use srfi-1)
(use srfi-11)

(define (count-nodes-aux tree ntab total uniq)
  (let ((nc (hash-table-get ntab tree #f)))
    (if nc
	(values (+ total nc -1) uniq)
	(cond
	 ((pair? tree)
	  (let*-values (((total1 uniq1)
			 (count-nodes-aux (car tree) ntab 
					  (+ total 1) (+ uniq 1)))
			((total2 uniq2)
			 (count-nodes-aux (cdr tree) ntab total1 uniq1)))
	     (hash-table-put! ntab tree (- total2 total -1))
	     (values total2 uniq2)))

	 ((null? tree)
	  (values total uniq))

	 (else
	  (values (+ total 0) (+ uniq 0)))))))

(define (count-nodes tree)
  (let ((ntab (make-hash-table)))
    (let-values (((uniq total) (count-nodes-aux tree ntab 0 0)))
      (list uniq total))))
 
(map (lambda (x) (print (count-nodes (gen-tree x)))) (iota 20 1))