module ELynx.Tree.Supported
( BranchSupport,
Supported (..),
normalizeBranchSupport,
collapse,
)
where
import Data.Bifoldable
import Data.Bifunctor
import Data.List
import ELynx.Tree.Rooted
type BranchSupport = Double
class Supported e where
getSup :: e -> BranchSupport
setSup :: BranchSupport -> e -> e
apply :: Supported e => (BranchSupport -> BranchSupport) -> e -> e
apply f l = setSup (f s) l where s = getSup l
normalizeBranchSupport :: Supported e => Tree e a -> Tree e a
normalizeBranchSupport t = first (apply (/ m)) t
where
m = bimaximum $ bimap getSup (const 0) t
collapse :: (Eq e, Eq a, Supported e) => BranchSupport -> Tree e a -> Tree e a
collapse th tr =
let tr' = collapse' th tr
in if tr == tr' then tr else collapse th tr'
highP :: Supported e => Double -> Tree e a -> Bool
highP _ (Node _ _ []) = True
highP th (Node br _ _) = getSup br >= th
collapse' :: Supported e => BranchSupport -> Tree e a -> Tree e a
collapse' th (Node br lb ts) = Node br lb $ map (collapse' th) (highSupport ++ lowSupportForest)
where
(highSupport, lowSupport) = partition (highP th) ts
lowSupportForest = concatMap forest lowSupport