module NLP.Partage.Tree.Other
(
Tree
, Node (..)
, SomeTree
, encode
, decode
, isTerm
, isFinal
, isInitial
, isAuxiliary
, hasRoot
, project
) where
import Control.Monad (msum)
import qualified Data.Foldable as F
import qualified Data.Tree as R
import qualified NLP.Partage.Tree as T
data Node n t
= NonTerm n
| Foot n
| Term t
deriving (Show, Eq, Ord)
isTerm :: Node n t -> Bool
isTerm (Term _) = True
isTerm _ = False
type Tree n t = R.Tree (Node n t)
type SomeTree n t = Either (T.Tree n t) (T.AuxTree n t)
encode :: SomeTree n t -> Tree n t
encode (Left t) = unTree t
encode (Right T.AuxTree{..}) = markFoot auxFoot (unTree auxTree)
unTree :: T.Tree n t -> Tree n t
unTree (T.Branch x xs) = R.Node (NonTerm x) (map unTree xs)
unTree (T.Leaf x) = R.Node (Term x) []
markFoot :: T.Path -> Tree n t -> Tree n t
markFoot [] (R.Node (NonTerm x) []) = R.Node (Foot x) []
markFoot (i:is) (R.Node y ys) =
R.Node y $ doit i ys
where
doit 0 (x:xs) = markFoot is x : xs
doit k (x:xs) = x : doit (k1) xs
doit _ _ = error "markFoot.doit: unhandled case"
markFoot _ _ = error "markFoot: unhandled case"
decode :: Tree n t -> SomeTree n t
decode t = case findFoot t of
Just is -> Right $ T.AuxTree (mkTree t) is
Nothing -> Left $ mkTree t
mkTree :: Tree n t -> T.Tree n t
mkTree (R.Node n xs) = case n of
Term x -> T.Leaf x
Foot x -> T.Branch
{ T.labelI = x
, T.subTrees = [] }
NonTerm x -> T.Branch
{ T.labelI = x
, T.subTrees = map mkTree xs }
findFoot :: Tree n t -> Maybe T.Path
findFoot (R.Node n xs) = case n of
Foot _ -> Just []
_ -> msum
$ zipWith addID [0..]
$ map findFoot xs
where
addID i (Just is) = Just (i:is)
addID _ Nothing = Nothing
isInitial :: Tree n t -> Bool
isInitial = not . isAuxiliary
isAuxiliary :: Tree n t -> Bool
isAuxiliary (R.Node (Foot _) _) = True
isAuxiliary (R.Node _ xs) = any isAuxiliary xs
isFinal :: Tree n t -> Bool
isFinal (R.Node n []) = isTerm n
isFinal (R.Node _ xs) = all isFinal xs
project :: Tree n t -> [t]
project =
F.foldMap term
where
term (Term x) = [x]
term _ = []
hasRoot :: Eq n => n -> Tree n t -> Bool
hasRoot x (R.Node (NonTerm y) _) = x == y
hasRoot _ _ = False