木の循環検知、こんな感じだとどうでしょうか?
shiroさんのページより http://practical-scheme.net/wiliki/wiliki.cgi?Shiro
最後の "Best solution" にあげられてる「うさぎと亀」はあらゆるLisp/Scheme処理系で使われていると思う。list?は循環リストについても停止しないとならないため。 (CLのlistpは最初のペアしか見ないのでちょっと違うが、 lengthなどは循環リストを検出しないとだめ)。
難しいのはcar方向にも循環する場合、つまり木の場合で、これはvisitした全ノードを何らかの方法で区別する (マークをつける、ハッシュテーブルに記録する、みつけたものから移動してゆく、など) しかないと思うのだけれど、もっと効率の良い方法はあるのだろうか。
木の場合も結局、「何とか優先」で順番に辿るわけなんで、うさぎを作っちゃうという考え方です。
(define (no-cycle?-aux tr tr2 fst) (if (and (not fst) (eq? tr tr2)) #f (if (pair? tr2) (and (if (pair? (car tr2)) (and (no-cycle?-aux (car tr) (car (car tr2)) #f) (no-cycle?-aux (car tr) (cdr (car tr2)) #f)) #t) (if (pair? (cdr tr2)) (and (no-cycle?-aux (cdr tr) (car (cdr tr2)) #f) (no-cycle?-aux (cdr tr) (cdr (cdr tr2)) #f)) #t)) #t))) (define (no-cycle? tr) (no-cycle?-aux tr tr #t)) (print (no-cycle? '(a b x))) (print (no-cycle? '((a b) x c))) (define n '((a b) x c)) (set-cdr! (cdr (car n)) (car n)) (print (no-cycle? n)) (define m '(a (a b) x c)) (set-car! m m) (print (no-cycle? n))
結果です
gosh ttra.scm #t #t #f #f
追記
いろいろ意見を頂いてありがたいです。ありがとうございます。
shiroさん
ところが、このアルゴリズムは全ノードについて探索が2分岐するから時間計算量はO(2^N)になる。
計算量の考察を全然していませんでした。O(2^N)じゃあダメですね。枝刈りして計算量が減らせるような気がするのでもう少し考えてみます。ビールを飲んだ後なのでそのまま寝ちゃうかもしれませんが・・・。
fujita-yさん
ろくなチェックしていないのがばればれですね。とりあえず改正版を作ってみました。
(define (no-cycle?-aux tr tr2 fst) (if (and (not fst) (eq? tr tr2) (not (equal? tr '()))) #f (if (and (pair? tr2) (pair? tr)) (and (if (pair? (car tr2)) (and (no-cycle?-aux (car tr) (car (car tr2)) #f) (no-cycle?-aux (car tr) (cdr (car tr2)) #f)) #t) (if (pair? (cdr tr2)) (and (no-cycle?-aux (cdr tr) (car (cdr tr2)) #f) (no-cycle?-aux (cdr tr) (cdr (cdr tr2)) #f)) #t)) #t)))
追記2
O(2^N)の件、うさぎさんは一杯子供を産むけどどれも違うノードを辿るのでO(2^N)にならないような気がしました。私の力では数学的に証明できないので、大きなデータを作って確かめてみました。確かめていたらバグを見つけたので、改定します。
これで計算量が増えましたが、それでもO(2^N)じゃ無いような気がします。
(print (no-cycle? '(#1=(a (b (c d) e) (f (g h) (i (j (k l) m))) (n (o p) (q r)) s (t (u v) (w x (y z #1#)))))))
葉のサイズが26で、関数呼び出し回数が326だったので、多く見積もってO(N^2)位だと思います。
(define cnt 0) (define (no-cycle?-aux tr tr2 fst) (set! cnt (+ cnt 1)) (if (and (not fst) (eq? tr tr2) (not (null? tr))) #f (if (and (pair? tr2) (pair? tr)) (and (if (pair? (car tr2)) (and (no-cycle?-aux (car tr) (car (car tr2)) #f) (no-cycle?-aux (cdr tr) (car (car tr2)) #f) (no-cycle?-aux (car tr) (cdr (car tr2)) #f) (no-cycle?-aux (cdr tr) (cdr (car tr2)) #f)) #t) (if (pair? (cdr tr2)) (and (no-cycle?-aux (car tr) (car (cdr tr2)) #f) (no-cycle?-aux (cdr tr) (car (cdr tr2)) #f) (no-cycle?-aux (car tr) (cdr (cdr tr2)) #f) (no-cycle?-aux (cdr tr) (cdr (cdr tr2)) #f)) #t)) #t))) (define (no-cycle? tr) (no-cycle?-aux tr tr #t)) (print (no-cycle? '(a b x))) (print (no-cycle? '((a b) x c))) (define n '((a b) x c)) (set-cdr! (cdr (car n)) (car n)) (print (no-cycle? n)) (define m '(a (a b) x c)) (set-car! m m) (print (no-cycle? n)) (print (no-cycle? '(1 (2 (3 4) ()) ()))) (print (no-cycle? '((a . #1=(c . d)) #1#))) (print (no-cycle? '(#1=(a (b (c d) e) (f (g h) (i (j (k l) m))) (n (o p) (q r)) s (t (u v) (w x (y z #1#))))))) (print (no-cycle? '(#1=(a (b (c d) e) (f (g h) (i (j (k l) m))) (n (o p) (q r)) s (t (u v) (w x (y z))))))) (print cnt)
出力結果です
gosh ttra.scm #t #t #f #f #t #t #f #t 665
追記3
shinhさんの「木ぽいののループ検出」(http://shinh.skr.jp/m/?date=20081202#p01) より
N^2 のサイズの木?に対して指数ぽい挙動になるような。
私も試してみました。
3 34 45 97 120 218 259 455 530 920 1061 1837 2108 3654 4183 7267 8310 14468 16537 28841 32960 57554 65771 114943 131354 229680 262477 459109 524676 917918
ほんどだー、指数ぽい。でも、この関数で生成される木ってどんなだろう?生成関数を追ってみたのですが、頭がこんがらがってきました。後で、graphvizで図示してみよう。