(2009.6)
GHCには薔薇木 (rose tree; multi-way tree; 複数の子を持つ木) クラスが用意されています。Data.Tree
次のように宣言されています。
Haskell
- data Tree a = Node {
- rootLabel :: a
- subForest :: Forest a
- }
-
- type Forest a = [Tree a]
ノードの値はrootLabelで、子の木のリストがsubForestです。
Treeはいくつかのクラスのインスタンスです。
- Monad, Functor, Typeable1, Traversable, Foldable, Applicative
また、型aが以下のクラスのインスタンスであれば、Tree aもまたそのクラスのインスタンスです。
簡単な木
オブジェクトを作ってみます。
Haskell
- import Data.Tree
-
- t :: Tree Int
- t = Node 1 [Node 2 [Node 3 [], Node 4 []], Node 5 []]
-
- main = do
- print t
-
- print $ flatten t
-
コンパイルは次のようにします。コンパイルには、ghc-containers-devel パッケージが必要です (Fedora 15, ghc 7.0)。
$ ghc tree.hs
木を舐める
ノードの値を足したり、個数を数えたりしてみます。
Haskell
- import Data.Tree
- import GHC.PArr
-
- t :: Tree Int
- t = Node 1 [Node 2 [Node 3 [Node 6 []], Node 4 [], Node 7[]], Node 5 []]
-
-
- sum_tree tree = rootLabel tree + (sum $ map sum_tree $ subForest tree)
-
-
-
- sum_treeP tree = rootLabel tree + (sumP $ mapP sum_tree $ toP $ subForest tree)
-
-
- length_tree :: Tree a -> Int
- length_tree tree = 1 + (sum $ map length_tree $ subForest tree)
-
-
- length_tree2 :: Tree a -> Int
- length_tree2 tree = 1 + (foldr (\n result -> result + length_tree2 n) 0 $ subForest tree)
-
-
- height_tree (Node _ []) = 1
- height_tree tree = 1 + (maximum $ map height_tree $ subForest tree)
-
- main = do
- print $ sum_tree t
- print $ sum_treeP t
- print $ length_tree t
- print $ length_tree2 t
- print $ height_tree t
テキストファイルから木を生成
Problem 67 - Project Euler のtriangle.txtファイル(これはグラフだが)から木オブジェクトを作ってみます。
まず、文字列を区切り文字で区切る関数。
Haskell
- import Data.Tree
-
-
- split :: (a -> Bool) -> [a] -> [[a]]
- split _ [] = []
- split p xs = a : case length b of 0 -> []
- 1 -> []:[]
- otherwise -> split p $ tail b
- where
- (a, b) = break p xs
後は、テキストを読み込んで、地道に木にします。
Haskell
-
- make_tree text_ary = foldr add_tree [] text_ary
-
- add_tree line result
- | null result = make_nodes line
- | otherwise = add_children (make_nodes line) result
-
-
- make_nodes :: String -> [Tree Int]
- make_nodes line =
- map (\x -> Node (read x) []) $ split (== ' ') line
-
-
- add_children :: [Tree Int] -> [Tree Int] -> [Tree Int]
- add_children [] _ = []
- add_children parents@(p:ps) children@(c1:c2:cs) =
- (Node (rootLabel p) [c1, c2]) : add_children ps (c2:cs)
-
- main = do
- cs <- getContents
- print $ make_tree $ lines cs