module ELynx.Topology.Phylogeny
( equal,
equal',
)
where
import Data.List
import Data.Maybe
import ELynx.Topology.Rooted
equal :: (Eq a, Ord a) => Topology a -> Topology a -> Either String Bool
equal :: Topology a -> Topology a -> Either String Bool
equal Topology a
tL Topology a
tR
| Topology a -> Bool
forall a. Ord a => Topology a -> Bool
duplicateLeaves Topology a
tL = String -> Either String Bool
forall a b. a -> Either a b
Left String
"equal: Left topology has duplicate leaves."
| Topology a -> Bool
forall a. Ord a => Topology a -> Bool
duplicateLeaves Topology a
tR = String -> Either String Bool
forall a b. a -> Either a b
Left String
"equal: Right topology has duplicate leaves."
| Bool
otherwise = Bool -> Either String Bool
forall a b. b -> Either a b
Right (Bool -> Either String Bool) -> Bool -> Either String Bool
forall a b. (a -> b) -> a -> b
$ Topology a -> Topology a -> Bool
forall a. Eq a => Topology a -> Topology a -> Bool
equal' Topology a
tL Topology a
tR
equal' :: Eq a => Topology a -> Topology a -> Bool
equal' :: Topology a -> Topology a -> Bool
equal' (Leaf a
lbL) (Leaf a
lbR) = a
lbL a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
lbR
equal' (Node Forest a
tsL) (Node Forest a
tsR) =
(Forest a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest a
tsL Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Forest a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest a
tsR)
Bool -> Bool -> Bool
&& (Topology a -> Bool) -> Forest a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Topology a -> Forest a -> Bool
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
Topology a -> t (Topology a) -> Bool
`elem'` Forest a
tsR) Forest a
tsL
where
elem' :: Topology a -> t (Topology a) -> Bool
elem' Topology a
t t (Topology a)
ts = Maybe (Topology a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Topology a) -> Bool) -> Maybe (Topology a) -> Bool
forall a b. (a -> b) -> a -> b
$ (Topology a -> Bool) -> t (Topology a) -> Maybe (Topology a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Topology a -> Topology a -> Bool
forall a. Eq a => Topology a -> Topology a -> Bool
equal' Topology a
t) t (Topology a)
ts
equal' Topology a
_ Topology a
_ = Bool
False