{-
- Tree data type. Every node is accessible from any other node.
-}
module Hmpf.Tree
( mkTree
, Tree
, up
, top
, branches
, build
, index
, isLeaf
, isRoot
, val
, path
, flatten ) where
import Data.List (elemIndex)
import Data.Maybe (fromJust)
data Tree a = Root (Branch a) |
Node (Tree a) a (Branch a)
type Branch a = [Tree a]
instance Eq a => Eq (Tree a) where
t == t' = (flatten t) == (flatten t')
up :: Tree a -> Tree a
up (Node t _ _) = t
up x = x
top (Root b) = Root b
top (Node p _ _) = top p
branches :: Tree a -> [Tree a]
branches (Root b) = b
branches (Node _ _ b) = b
--True if it is the root node
isRoot (Root _) = True
isRoot _ = False
--True if the node has no children
isLeaf t = (length . branches $ t ) == 0
val :: Tree a -> Maybe a
val (Node r x b) = Just x
val _ = Nothing
mkTree :: ( a -> [(b, a)] ) -> a -> Tree b
mkTree f x =
let root = Root children
children = map (mkBranches root f) (f x)
in root
mkBranches :: Tree b -> ( a -> [(b,a)] ) -> (b, a) -> Tree b
mkBranches root f (n,x) =
let node = Node root n children
children = map (mkBranches node f) (f x)
in node
build :: Eq a => [[a]] -> [(a,[[a]])]
build lst =
let lst' = filter (not.null) $ lst
in case lst' of
[] -> []
(x:xs) -> let c = head x
lst'' = map tail . filter (\i -> head i ==c) $ (x:xs)
rest = filter (\i -> head i/=c) (x:xs)
in (c,lst''):(build rest)
path :: Tree a -> [a]
path t =
case val t of
Nothing -> []
Just x -> x:(path . up $ t )
flatten :: Tree a -> [[a]]
flatten tree =
case val tree of
Nothing -> rest
Just x -> case (branches tree) of
[] -> [[x]]
_ -> map (x:) rest
where
rest = concat . map flatten . branches $ tree
index :: Eq a => Tree a -> Int
index (Root _) = 0
index tree = fromJust . elemIndex tree . branches . up $ tree
eol = '^'
t = mkTree build . map ( ++[eol] ) $ ["li","lic"]