2003-08-21 [長年日記]
λ. Re: 頭の体操。
(子)リストのリストがあって、子リストにはシンボルが2個以上入ってたとする。たとえば、((A B) (C D) (E F) (A G) (H F I)) のような感じ。
これを、同じシンボルを含む子リストはまとめたいとする。たとえば、例で言えば ((A B G) (C D) (E F H I)) のようなリストを返す。
最初に思いついたコードはこんなの。かっこ悪いな。しかも破壊的な関数使ってしまったし。
(use srfi-1)
(define (solve data)
(define cells (map (lambda (x) (cons #t x)) data))
(define (last-cell cell) (if (car cell) cell (last-cell (cdr cell))))
(define (for-each-unordered-pair f l)
(if (not (null? l))
(let ((x (car l))
(xs (cdr l)))
(for-each (lambda (y) (f x y)) xs)
(for-each-unordered-pair f xs))))
(for-each-unordered-pair
(lambda (a b)
(let ((a2 (last-cell a))
(b2 (last-cell b)))
(if (and (not (eq? a2 b2))
(not (null? (lset-intersection eq? (cdr a2) (cdr b2)))))
(begin
(set-cdr! a2 (lset-union eq? (cdr a2) (cdr b2)))
(set-car! b2 #f)
(set-cdr! b2 a2)
))))
cells)
(delete-duplicates
(map (lambda (cell) (cdr (last-cell cell))) cells)
eq?))
(display (solve '((A B) (C D) (E F) (A G) (H F I))))
;=> ((G A B) (C D) (I H E F))
module Main where<br>import List<br>solve :: Eq a => [[a]] -> [[a]]<br>solve = foldr foo []<br>foo :: Eq a => [a] -> [[a]] -> [[a]]<br>foo x [] = [x]<br>foo x (c:cs)<br> = case bar x c of<br> Nothing -> c : foo x cs<br> Just xc -> foo xc cs<br>bar :: Eq a => [a] -> [a] -> Maybe [a]<br>bar ps qs<br> = case intersect ps qs of<br> [] -> Nothing<br> is -> Just $ union ps qs<br>
Maybe なんか使う必要なかった。:(
おー、なるほど。<br>これもfoldrでいきますか。<br>Haskellらしいですね。<br><br>P.S.<br>そういえば、HaskellでUnion-Findアルゴリズムって書けるのかなぁ……
Shiro さんとこの wiliki の Y.Hana さんのアイデアを Haskell での実装<br><br>solve' :: Eq a => [[a]] -> [[a]]<br>solve' cs = foldr foo' cs (bar' cs)<br>foo' :: Eq a => a -> [[a]] -> [[a]]<br>foo' x cs = case partition (elem x) cs of<br> (ps,qs) -> bar' ps : qs<br>bar' :: Eq a => [[a]] -> [a]<br>bar' = foldr union []
Haskell での Union-Find の例<br>http://www.cs.bris.ac.uk/Teaching/Resources/COMS21101/2001-2/cw/Set.hs
そのY.Hanaさんのコードは、もともとHaskellで書いたのをSchemeで書き直したもののようですよ。<br><br>http://www.lab2.kuis.kyoto-u.ac.jp/~hanatani/tdiary/?date=20030822<br>より引用<br><br>import List<br> <br>solve xs = foldr solve' xs (concat xs)<br> <br>solve' x xs = case partition (elem x) xs of<br> (p, q) -> foldl union [] p : q
なんと ^^;
> Haskell での Union-Find の例<br>> http://www.cs.bris.ac.uk/Teaching/Resources/COMS21101/2001-2/cw/Set.hs<br><br>えっと、Union-Find アルゴリズムというのは、<br>http://www.na.cse.nagoya-u.ac.jp/~reiji/lect/alg99/frm7-3.html<br>で紹介されているようなアルゴリズムのことです。<br><br>私が最初に書いたコードもこのアルゴリズムが念頭にありました。<br>経路圧縮とランクによる統合は面倒だったのでやりませんでしたけど (^^;)