Island Life

< またc.l.sネタだが。Original... | ねるWiki:NelDiary:2005... >

2005/11/15

Uuutokudaの日記2005-11-15より:

やっぱり人のコーディングスタイルとかを見るのは勉強になる。 [...] で、そこで皆さんのコードをみてみたいのである。 [...] で、あんまり複雑なのは面倒なので非常に簡単な問題。

二つのツリー(もしくはリスト)が等価であるかどうかを判定するプログラムを示せ。
(深さ優先探索したときの各葉の要素の並びが2つのツリーで等価ってこと)

たとえば、(1 (2 3) (4)) と(1 (2 (3 (4))))は等価である。

この方はさらっと書かれているが、これはsamefringe problemと呼ばれる なかなかに興味深い問題である。ナイーブな解は、ツリーの全ての要素を列挙した リスト(flattenしたもの、と言ってもよい)を作ってそれらを比べるというものだが、 もしツリーが巨大なものであり、しかもそれらが異なっていた場合、 flattenの作業の大部分が無駄になってしまう。

ところが必要最低限の空間複雑度で計算しようとすると、 「同型でないデータ構造を再帰する」というちょっと厄介な問題を解かねばならない。 コルーチンで解く方法もあるが、遅延ストリームを使うと再帰の部分が ジェネレータに隠されてわりと素直に書ける。

(use util.stream)

(define (samefringe? t1 t2)
  (define (make-gen tree)
    (stream-delay
     (cond ((null? tree) stream-null)
           ((pair? tree)
            (stream-append (make-gen (car tree)) (make-gen (cdr tree))))

           (else (stream tree)))))
  (let loop ((s1 (make-gen t1))
             (s2 (make-gen t2)))
    (or (and (stream-null? s1) (stream-null? s2))
        (and (stream-pair? s1) (stream-pair? s2)
             (equal? (stream-car s1) (stream-car s2))
             (loop (stream-cdr s1) (stream-cdr s2))))))

streamに隠された継続を陽に扱って継続渡し形式にしても良いが、 あまりわかりやすくはない。

(define (samefringe? t1 t2)
  (define (traverse g1 g2)
    (g1 (lambda (e1 end1? rest1)
          (g2 (lambda (e2 end2? rest2)
                (or (and end1? end2?)
                    (and (equal? e1 e2) (traverse rest1 rest2))))))))
  (define (end c) (c #f #t #f))
  (define (genfringe tree c rest)
    (cond ((null? tree) (rest c))
          ((pair? tree)
           (genfringe (car tree) c
                      (lambda (c) (genfringe (cdr tree) c rest))))
          (else (c tree #f rest))))
  (traverse (lambda (c) (genfringe t1 c end))
            (lambda (c) (genfringe t2 c end))))

コルーチンによるもの、継続渡しによるもの、遅延ストリームによるものは どれも本質的に同型の解になり、木の深さDに対して最悪O(D)の空間を必要とする。

(なお、良く見るsamefringe problemではコンスセルを2分木として扱う、つまり fringe (1 (2 3) 4) => (1 2 3 () 4 ()) とみなすことが多いが、 ここでは元の問題に合わせた。)

Haskellならもともとlazyだからこれでいいのかな。

data Tree a = Leaf a | Branch [Tree a]

fringe :: Tree a -> [a]
fringe (Leaf x)   = [x]
fringe (Branch x) = foldr (\x r -> fringe x ++ r) [] x

samefringe :: Eq a => Tree a -> Tree a -> Bool
samefringe x y = fringe x == fringe y

参考: Henry Baker, Iterators: Signs of Weakness in Object-Oriented Languages, ACM OOPS Messenger 4, 3 (July 1993), 18-25. http://home.pipeline.com/~hbaker1/Iterator.html

Tags: Programming, Scheme, Haskell