module Data.LCRSTree where
import Data.Foldable as F
import Data.Tree (Tree)
import qualified Data.Tree as T
data LCRSTree n = Empty
| Leaf n (LCRSTree n)
| Node n (LCRSTree n) (LCRSTree n)
deriving (Show, Eq)
instance Functor LCRSTree where
fmap _ Empty = Empty
fmap f (Leaf a s) = Leaf (f a) (fmap f s)
fmap f (Node n c s) = Node (f n) (fmap f c) (fmap f s)
instance Foldable LCRSTree where
foldr _ z Empty = z
foldr f z (Leaf n s) = F.foldr f (f n z) s
foldr f z (Node n c s) =
let v = F.foldr f (f n z) c
in F.foldr f v s
lcrsDepth :: Integral i => LCRSTree n -> i
lcrsDepth = depth 0
where
depth i Empty = i
depth i (Leaf _ s) = depth i s
depth i (Node _ c s) =
let lDepth = depth (i + 1) c
rDepth = depth i s
in max lDepth rDepth
fromRoseTree :: Tree n -> LCRSTree n
fromRoseTree t = mkWithS t []
where
mkWithS (T.Node n []) ss = Leaf n $ siblings ss
mkWithS (T.Node n ch) ss =
let mkN = case ch of
[] -> Leaf n
(c:cs) -> Node n (mkWithS c cs)
in mkN $ siblings ss
siblings [] = Empty
siblings (c:cs) = mkWithS c cs
toRoseTree :: LCRSTree n -> Tree n
toRoseTree (Node topN topC Empty) = T.Node topN (collectS topC)
where
collectS Empty = []
collectS (Leaf a s) = T.Node a [] : collectS s
collectS (Node n c s) = T.Node n (collectS c) : collectS s
toRoseTree _ = error "fromLCRSTree: non-top node passed"