{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
module ELynx.Tree.Phylogeny
(
equal,
equal',
intersect,
bifurcating,
outgroup,
midpoint,
roots,
Phylo (..),
toPhyloTree,
measurableToPhyloTree,
supportedToPhyloTree,
phyloToLengthTree,
phyloToSupportTree,
phyloToSupportTreeUnsafe,
PhyloExplicit (..),
toExplicitTree,
)
where
import Control.DeepSeq
import Data.Aeson
import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable
import Data.List hiding (intersect)
import Data.Maybe
import Data.Monoid
import Data.Semigroup
import Data.Set (Set)
import qualified Data.Set as S
import ELynx.Tree.Bipartition
import ELynx.Tree.Length
import ELynx.Tree.Rooted
import ELynx.Tree.Splittable
import ELynx.Tree.Support
import GHC.Generics
equal :: (Eq e, Eq a, Ord a) => Tree e a -> Tree e a -> Either String Bool
equal :: Tree e a -> Tree e a -> Either String Bool
equal Tree e a
tL Tree e a
tR
| Tree e a -> Bool
forall a e. Ord a => Tree e a -> Bool
duplicateLeaves Tree e a
tL = String -> Either String Bool
forall a b. a -> Either a b
Left String
"equal: Left tree has duplicate leaves."
| Tree e a -> Bool
forall a e. Ord a => Tree e a -> Bool
duplicateLeaves Tree e a
tR = String -> Either String Bool
forall a b. a -> Either a b
Left String
"equal: Right tree 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
$ Tree e a -> Tree e a -> Bool
forall e a. (Eq e, Eq a) => Tree e a -> Tree e a -> Bool
equal' Tree e a
tL Tree e a
tR
equal' :: (Eq e, Eq a) => Tree e a -> Tree e a -> Bool
equal' :: Tree e a -> Tree e a -> Bool
equal' ~(Node e
brL a
lbL Forest e a
tsL) ~(Node e
brR a
lbR Forest e a
tsR) =
(e
brL e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
brR)
Bool -> Bool -> Bool
&& (a
lbL a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
lbR)
Bool -> Bool -> Bool
&& (Forest e a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest e a
tsL Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Forest e a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest e a
tsR)
Bool -> Bool -> Bool
&& (Tree e a -> Bool) -> Forest e a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Forest e a -> Tree e a -> Bool
forall (t :: * -> *) e a.
(Foldable t, Eq e, Eq a) =>
t (Tree e a) -> Tree e a -> Bool
elem' Forest e a
tsR) Forest e a
tsL
where
elem' :: t (Tree e a) -> Tree e a -> Bool
elem' t (Tree e a)
ts Tree e a
t = Maybe (Tree e a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Tree e a) -> Bool) -> Maybe (Tree e a) -> Bool
forall a b. (a -> b) -> a -> b
$ (Tree e a -> Bool) -> t (Tree e a) -> Maybe (Tree e a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Tree e a -> Tree e a -> Bool
forall e a. (Eq e, Eq a) => Tree e a -> Tree e a -> Bool
equal' Tree e a
t) t (Tree e a)
ts
intersect ::
(Semigroup e, Eq e, Ord a) => Forest e a -> Either String (Forest e a)
intersect :: Forest e a -> Either String (Forest e a)
intersect Forest e a
ts
| Set a -> Bool
forall a. Set a -> Bool
S.null Set a
lvsCommon = String -> Either String (Forest e a)
forall a b. a -> Either a b
Left String
"intersect: Intersection of leaves is empty."
| Bool
otherwise = case [Maybe (Tree e a)] -> Maybe (Forest e a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [(a -> Bool) -> Tree e a -> Maybe (Tree e a)
forall a e. (a -> Bool) -> Tree e a -> Maybe (Tree e a)
dropLeavesWith (Set a -> a -> Bool
forall a. Ord a => Set a -> a -> Bool
predicate Set a
ls) Tree e a
t | (Set a
ls, Tree e a
t) <- [Set a] -> Forest e a -> [(Set a, Tree e a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Set a]
leavesToDrop Forest e a
ts] of
Maybe (Forest e a)
Nothing -> String -> Either String (Forest e a)
forall a b. a -> Either a b
Left String
"intersect: A tree is empty."
Just Forest e a
ts' -> Forest e a -> Either String (Forest e a)
forall a b. b -> Either a b
Right Forest e a
ts'
where
lvss :: [Set a]
lvss = (Tree e a -> Set a) -> Forest e a -> [Set a]
forall a b. (a -> b) -> [a] -> [b]
map ([a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> (Tree e a -> [a]) -> Tree e a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree e a -> [a]
forall e a. Tree e a -> [a]
leaves) Forest e a
ts
lvsCommon :: Set a
lvsCommon = (Set a -> Set a -> Set a) -> [Set a] -> Set a
forall a. (a -> a -> a) -> [a] -> a
foldl1' Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.intersection [Set a]
lvss
leavesToDrop :: [Set a]
leavesToDrop = (Set a -> Set a) -> [Set a] -> [Set a]
forall a b. (a -> b) -> [a] -> [b]
map (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.\\ Set a
lvsCommon) [Set a]
lvss
predicate :: Set a -> a -> Bool
predicate Set a
lvsToDr a
l = a
l a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
lvsToDr
bifurcating :: Tree e a -> Bool
bifurcating :: Tree e a -> Bool
bifurcating (Node e
_ a
_ []) = Bool
True
bifurcating (Node e
_ a
_ [Tree e a
x, Tree e a
y]) = Tree e a -> Bool
forall e a. Tree e a -> Bool
bifurcating Tree e a
x Bool -> Bool -> Bool
&& Tree e a -> Bool
forall e a. Tree e a -> Bool
bifurcating Tree e a
y
bifurcating Tree e a
_ = Bool
False
outgroup :: (Semigroup e, Splittable e, Monoid a, Ord a) => Set a -> Tree e a -> Either String (Tree e a)
outgroup :: Set a -> Tree e a -> Either String (Tree e a)
outgroup Set a
_ (Node e
_ a
_ []) = String -> Either String (Tree e a)
forall a b. a -> Either a b
Left String
"outgroup: Root node is a leaf."
outgroup Set a
_ (Node e
_ a
_ [Tree e a
_]) = String -> Either String (Tree e a)
forall a b. a -> Either a b
Left String
"outgroup: Root node has degree two."
outgroup Set a
o t :: Tree e a
t@(Node e
_ a
_ [Tree e a
_, Tree e a
_]) = do
Bipartition a
bip <- Set a -> Set a -> Either String (Bipartition a)
forall a. Ord a => Set a -> Set a -> Either String (Bipartition a)
bp Set a
o ([a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList (Tree e a -> [a]
forall e a. Tree e a -> [a]
leaves Tree e a
t) Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.\\ Set a
o)
Bipartition a -> Tree e a -> Either String (Tree e a)
forall e a.
(Semigroup e, Splittable e, Eq a, Ord a) =>
Bipartition a -> Tree e a -> Either String (Tree e a)
rootAt Bipartition a
bip Tree e a
t
outgroup Set a
o (Node e
b a
l [Tree e a]
ts) = Set a -> Tree e a -> Either String (Tree e a)
forall e a.
(Semigroup e, Splittable e, Monoid a, Ord a) =>
Set a -> Tree e a -> Either String (Tree e a)
outgroup Set a
o Tree e a
t'
where
(Node e
brO a
lbO [Tree e a]
tsO) = [Tree e a] -> Tree e a
forall a. [a] -> a
head [Tree e a]
ts
t' :: Tree e a
t' = e -> a -> [Tree e a] -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node e
b a
forall a. Monoid a => a
mempty [e -> a -> [Tree e a] -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node (e -> e
forall e. Splittable e => e -> e
split e
brO) a
lbO [Tree e a]
tsO, e -> a -> [Tree e a] -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node (e -> e
forall e. Splittable e => e -> e
split e
brO) a
l ([Tree e a] -> [Tree e a]
forall a. [a] -> [a]
tail [Tree e a]
ts)]
midpoint :: (Semigroup e, Splittable e, HasLength e) => Tree e a -> Either String (Tree e a)
midpoint :: Tree e a -> Either String (Tree e a)
midpoint (Node e
_ a
_ []) = String -> Either String (Tree e a)
forall a b. a -> Either a b
Left String
"midpoint: Root node is a leaf."
midpoint (Node e
_ a
_ [Tree e a
_]) = String -> Either String (Tree e a)
forall a b. a -> Either a b
Left String
"midpoint: Root node has degree two."
midpoint t :: Tree e a
t@(Node e
_ a
_ [Tree e a
_, Tree e a
_]) = Tree e a -> Either String [Tree e a]
forall e a.
(Semigroup e, Splittable e) =>
Tree e a -> Either String (Forest e a)
roots Tree e a
t Either String [Tree e a]
-> ([Tree e a] -> Either String (Tree e a))
-> Either String (Tree e a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Tree e a] -> Either String (Tree e a)
forall e a. HasLength e => [Tree e a] -> Either String (Tree e a)
getMidpoint
midpoint Tree e a
_ = String -> Either String (Tree e a)
forall a b. a -> Either a b
Left String
"midpoint: Root node is multifurcating."
findMinIndex :: Ord a => [a] -> Either String Int
findMinIndex :: [a] -> Either String Int
findMinIndex (a
x : [a]
xs) = (Int, a) -> Int -> [a] -> Either String Int
forall b a a. (Ord b, Num a) => (a, b) -> a -> [b] -> Either a a
go (Int
0, a
x) Int
1 [a]
xs
where
go :: (a, b) -> a -> [b] -> Either a a
go (a
i, b
_) a
_ [] = a -> Either a a
forall a b. b -> Either a b
Right a
i
go (a
i, b
z) a
j (b
y : [b]
ys) = if b
z b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
y then (a, b) -> a -> [b] -> Either a a
go (a
i, b
z) (a
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) [b]
ys else (a, b) -> a -> [b] -> Either a a
go (a
j, b
y) (a
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) [b]
ys
findMinIndex [] = String -> Either String Int
forall a b. a -> Either a b
Left String
"findMinIndex: Empty list."
getMidpoint :: HasLength e => [Tree e a] -> Either String (Tree e a)
getMidpoint :: [Tree e a] -> Either String (Tree e a)
getMidpoint [Tree e a]
ts = case Either String (Tree e a)
t of
Right (Node e
br a
lb [Tree e a
l, Tree e a
r]) ->
let hl :: Length
hl = Tree e a -> Length
forall e a. HasLength e => Tree e a -> Length
height Tree e a
l
hr :: Length
hr = Tree e a -> Length
forall e a. HasLength e => Tree e a -> Length
height Tree e a
r
dh :: Length
dh = (Length
hl Length -> Length -> Length
forall a. Num a => a -> a -> a
- Length
hr) Length -> Length -> Length
forall a. Fractional a => a -> a -> a
/ Length
2
in Tree e a -> Either String (Tree e a)
forall a b. b -> Either a b
Right (Tree e a -> Either String (Tree e a))
-> Tree e a -> Either String (Tree e a)
forall a b. (a -> b) -> a -> b
$
e -> a -> [Tree e a] -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node
e
br
a
lb
[ (e -> e) -> Tree e a -> Tree e a
forall e a. (e -> e) -> Tree e a -> Tree e a
applyStem ((Length -> Length) -> e -> e
forall e. HasLength e => (Length -> Length) -> e -> e
modLen (Length -> Length -> Length
forall a. Num a => a -> a -> a
subtract Length
dh)) Tree e a
l,
(e -> e) -> Tree e a -> Tree e a
forall e a. (e -> e) -> Tree e a -> Tree e a
applyStem ((Length -> Length) -> e -> e
forall e. HasLength e => (Length -> Length) -> e -> e
modLen (Length -> Length -> Length
forall a. Num a => a -> a -> a
+ Length
dh)) Tree e a
r
]
Right Tree e a
_ -> String -> Either String (Tree e a)
forall a. HasCallStack => String -> a
error String
"getMidpoint: Root node is not bifurcating; please contact maintainer."
Left String
e -> String -> Either String (Tree e a)
forall a b. a -> Either a b
Left String
e
where
dhs :: [Length]
dhs = (Tree e a -> Length) -> [Tree e a] -> [Length]
forall a b. (a -> b) -> [a] -> [b]
map Tree e a -> Length
forall e a. HasLength e => Tree e a -> Length
getDeltaHeight [Tree e a]
ts
t :: Either String (Tree e a)
t = ([Tree e a]
ts [Tree e a] -> Int -> Tree e a
forall a. [a] -> Int -> a
!!) (Int -> Tree e a) -> Either String Int -> Either String (Tree e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Length] -> Either String Int
forall a. Ord a => [a] -> Either String Int
findMinIndex [Length]
dhs
getDeltaHeight :: HasLength e => Tree e a -> Length
getDeltaHeight :: Tree e a -> Length
getDeltaHeight (Node e
_ a
_ [Tree e a
l, Tree e a
r]) = Length -> Length
forall a. Num a => a -> a
abs (Length -> Length) -> Length -> Length
forall a b. (a -> b) -> a -> b
$ Tree e a -> Length
forall e a. HasLength e => Tree e a -> Length
height Tree e a
l Length -> Length -> Length
forall a. Num a => a -> a -> a
- Tree e a -> Length
forall e a. HasLength e => Tree e a -> Length
height Tree e a
r
getDeltaHeight Tree e a
_ = String -> Length
forall a. HasCallStack => String -> a
error String
"getDeltaHeight: Root node is not bifurcating; please contact maintainer."
roots :: (Semigroup e, Splittable e) => Tree e a -> Either String (Forest e a)
roots :: Tree e a -> Either String (Forest e a)
roots (Node e
_ a
_ []) = String -> Either String (Forest e a)
forall a b. a -> Either a b
Left String
"roots: Root node is a leaf."
roots (Node e
_ a
_ [Tree e a
_]) = String -> Either String (Forest e a)
forall a b. a -> Either a b
Left String
"roots: Root node has degree two."
roots t :: Tree e a
t@(Node e
b a
c [Tree e a
tL, Tree e a
tR]) = Forest e a -> Either String (Forest e a)
forall a b. b -> Either a b
Right (Forest e a -> Either String (Forest e a))
-> Forest e a -> Either String (Forest e a)
forall a b. (a -> b) -> a -> b
$ Tree e a
t Tree e a -> Forest e a -> Forest e a
forall a. a -> [a] -> [a]
: e -> a -> Tree e a -> Tree e a -> Forest e a
forall e a.
(Semigroup e, Splittable e) =>
e -> a -> Tree e a -> Tree e a -> Forest e a
descend e
b a
c Tree e a
tR Tree e a
tL Forest e a -> Forest e a -> Forest e a
forall a. [a] -> [a] -> [a]
++ e -> a -> Tree e a -> Tree e a -> Forest e a
forall e a.
(Semigroup e, Splittable e) =>
e -> a -> Tree e a -> Tree e a -> Forest e a
descend e
b a
c Tree e a
tL Tree e a
tR
roots Tree e a
_ = String -> Either String (Forest e a)
forall a b. a -> Either a b
Left String
"roots: Root node is multifurcating."
complementaryForests :: Tree e a -> Forest e a -> [Forest e a]
complementaryForests :: Tree e a -> Forest e a -> [Forest e a]
complementaryForests Tree e a
t Forest e a
ts = [Tree e a
t Tree e a -> Forest e a -> Forest e a
forall a. a -> [a] -> [a]
: Int -> Forest e a -> Forest e a
forall a. Int -> [a] -> [a]
take Int
i Forest e a
ts Forest e a -> Forest e a -> Forest e a
forall a. [a] -> [a] -> [a]
++ Int -> Forest e a -> Forest e a
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Forest e a
ts | Int
i <- [Int
0 .. (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]]
where
n :: Int
n = Forest e a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Forest e a
ts
descend :: (Semigroup e, Splittable e) => e -> a -> Tree e a -> Tree e a -> Forest e a
descend :: e -> a -> Tree e a -> Tree e a -> Forest e a
descend e
_ a
_ Tree e a
_ (Node e
_ a
_ []) = []
descend e
brR a
lbR Tree e a
tC (Node e
brD a
lbD Forest e a
tsD) =
[ e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node e
brR a
lbR [e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node (e -> e
forall e. Splittable e => e -> e
split e
brDd) a
lbD Forest e a
f, e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node (e -> e
forall e. Splittable e => e -> e
split e
brDd) a
lbDd Forest e a
tsDd]
| (Node e
brDd a
lbDd Forest e a
tsDd, Forest e a
f) <- Forest e a -> [Forest e a] -> [(Tree e a, Forest e a)]
forall a b. [a] -> [b] -> [(a, b)]
zip Forest e a
tsD [Forest e a]
cfs
]
Forest e a -> Forest e a -> Forest e a
forall a. [a] -> [a] -> [a]
++ [Forest e a] -> Forest e a
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ e -> a -> Tree e a -> Tree e a -> Forest e a
forall e a.
(Semigroup e, Splittable e) =>
e -> a -> Tree e a -> Tree e a -> Forest e a
descend e
brR a
lbR (e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node (e -> e
forall e. Splittable e => e -> e
split e
brDd) a
lbD Forest e a
f) (e -> a -> Forest e a -> Tree e a
forall e a. e -> a -> Forest e a -> Tree e a
Node (e -> e
forall e. Splittable e => e -> e
split e
brDd) a
lbDd Forest e a
tsDd)
| (Node e
brDd a
lbDd Forest e a
tsDd, Forest e a
f) <- Forest e a -> [Forest e a] -> [(Tree e a, Forest e a)]
forall a b. [a] -> [b] -> [(a, b)]
zip Forest e a
tsD [Forest e a]
cfs
]
where
brC' :: e
brC' = Tree e a -> e
forall e a. Tree e a -> e
branch Tree e a
tC e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
brD
tC' :: Tree e a
tC' = Tree e a
tC {branch :: e
branch = e
brC'}
cfs :: [Forest e a]
cfs = Tree e a -> Forest e a -> [Forest e a]
forall e a. Tree e a -> Forest e a -> [Forest e a]
complementaryForests Tree e a
tC' Forest e a
tsD
rootAt ::
(Semigroup e, Splittable e, Eq a, Ord a) =>
Bipartition a ->
Tree e a ->
Either String (Tree e a)
rootAt :: Bipartition a -> Tree e a -> Either String (Tree e a)
rootAt Bipartition a
b Tree e a
t
| [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
lvLst Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Set a -> Int
forall a. Set a -> Int
S.size Set a
lvSet = String -> Either String (Tree e a)
forall a b. a -> Either a b
Left String
"rootAt: Tree has duplicate leaves."
| Bipartition a -> Set a
forall a. Ord a => Bipartition a -> Set a
toSet Bipartition a
b Set a -> Set a -> Bool
forall a. Eq a => a -> a -> Bool
/= Set a
lvSet = String -> Either String (Tree e a)
forall a b. a -> Either a b
Left String
"rootAt: Bipartition does not match leaves of tree."
| Bool
otherwise = Bipartition a -> Tree e a -> Either String (Tree e a)
forall e a.
(Semigroup e, Splittable e, Ord a) =>
Bipartition a -> Tree e a -> Either String (Tree e a)
rootAt' Bipartition a
b Tree e a
t
where
lvLst :: [a]
lvLst = Tree e a -> [a]
forall e a. Tree e a -> [a]
leaves Tree e a
t
lvSet :: Set a
lvSet = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ Tree e a -> [a]
forall e a. Tree e a -> [a]
leaves Tree e a
t
rootAt' ::
(Semigroup e, Splittable e, Ord a) =>
Bipartition a ->
Tree e a ->
Either String (Tree e a)
rootAt' :: Bipartition a -> Tree e a -> Either String (Tree e a)
rootAt' Bipartition a
b Tree e a
t = do
Forest e a
ts <- Tree e a -> Either String (Forest e a)
forall e a.
(Semigroup e, Splittable e) =>
Tree e a -> Either String (Forest e a)
roots Tree e a
t
case (Tree e a -> Bool) -> Forest e a -> Maybe (Tree e a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Tree e a
x -> Tree e a -> Either String (Bipartition a)
forall a e. Ord a => Tree e a -> Either String (Bipartition a)
bipartition Tree e a
x Either String (Bipartition a)
-> Either String (Bipartition a) -> Bool
forall a. Eq a => a -> a -> Bool
== Bipartition a -> Either String (Bipartition a)
forall a b. b -> Either a b
Right Bipartition a
b) Forest e a
ts of
Maybe (Tree e a)
Nothing -> String -> Either String (Tree e a)
forall a b. a -> Either a b
Left String
"rootAt': Bipartition not found on tree."
Just Tree e a
t' -> Tree e a -> Either String (Tree e a)
forall a b. b -> Either a b
Right Tree e a
t'
data Phylo = Phylo
{ Phylo -> Maybe Length
brLen :: Maybe Length,
Phylo -> Maybe Support
brSup :: Maybe Support
}
deriving (ReadPrec [Phylo]
ReadPrec Phylo
Int -> ReadS Phylo
ReadS [Phylo]
(Int -> ReadS Phylo)
-> ReadS [Phylo]
-> ReadPrec Phylo
-> ReadPrec [Phylo]
-> Read Phylo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Phylo]
$creadListPrec :: ReadPrec [Phylo]
readPrec :: ReadPrec Phylo
$creadPrec :: ReadPrec Phylo
readList :: ReadS [Phylo]
$creadList :: ReadS [Phylo]
readsPrec :: Int -> ReadS Phylo
$creadsPrec :: Int -> ReadS Phylo
Read, Int -> Phylo -> ShowS
[Phylo] -> ShowS
Phylo -> String
(Int -> Phylo -> ShowS)
-> (Phylo -> String) -> ([Phylo] -> ShowS) -> Show Phylo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Phylo] -> ShowS
$cshowList :: [Phylo] -> ShowS
show :: Phylo -> String
$cshow :: Phylo -> String
showsPrec :: Int -> Phylo -> ShowS
$cshowsPrec :: Int -> Phylo -> ShowS
Show, Phylo -> Phylo -> Bool
(Phylo -> Phylo -> Bool) -> (Phylo -> Phylo -> Bool) -> Eq Phylo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Phylo -> Phylo -> Bool
$c/= :: Phylo -> Phylo -> Bool
== :: Phylo -> Phylo -> Bool
$c== :: Phylo -> Phylo -> Bool
Eq, Eq Phylo
Eq Phylo
-> (Phylo -> Phylo -> Ordering)
-> (Phylo -> Phylo -> Bool)
-> (Phylo -> Phylo -> Bool)
-> (Phylo -> Phylo -> Bool)
-> (Phylo -> Phylo -> Bool)
-> (Phylo -> Phylo -> Phylo)
-> (Phylo -> Phylo -> Phylo)
-> Ord Phylo
Phylo -> Phylo -> Bool
Phylo -> Phylo -> Ordering
Phylo -> Phylo -> Phylo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Phylo -> Phylo -> Phylo
$cmin :: Phylo -> Phylo -> Phylo
max :: Phylo -> Phylo -> Phylo
$cmax :: Phylo -> Phylo -> Phylo
>= :: Phylo -> Phylo -> Bool
$c>= :: Phylo -> Phylo -> Bool
> :: Phylo -> Phylo -> Bool
$c> :: Phylo -> Phylo -> Bool
<= :: Phylo -> Phylo -> Bool
$c<= :: Phylo -> Phylo -> Bool
< :: Phylo -> Phylo -> Bool
$c< :: Phylo -> Phylo -> Bool
compare :: Phylo -> Phylo -> Ordering
$ccompare :: Phylo -> Phylo -> Ordering
$cp1Ord :: Eq Phylo
Ord, (forall x. Phylo -> Rep Phylo x)
-> (forall x. Rep Phylo x -> Phylo) -> Generic Phylo
forall x. Rep Phylo x -> Phylo
forall x. Phylo -> Rep Phylo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Phylo x -> Phylo
$cfrom :: forall x. Phylo -> Rep Phylo x
Generic, Phylo -> ()
(Phylo -> ()) -> NFData Phylo
forall a. (a -> ()) -> NFData a
rnf :: Phylo -> ()
$crnf :: Phylo -> ()
NFData)
instance Semigroup Phylo where
Phylo Maybe Length
mBL Maybe Support
mSL <> :: Phylo -> Phylo -> Phylo
<> Phylo Maybe Length
mBR Maybe Support
mSR =
Maybe Length -> Maybe Support -> Phylo
Phylo
(Sum Length -> Length
forall a. Sum a -> a
getSum (Sum Length -> Length) -> Maybe (Sum Length) -> Maybe Length
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Length -> Sum Length
forall a. a -> Sum a
Sum (Length -> Sum Length) -> Maybe Length -> Maybe (Sum Length)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Length
mBL) Maybe (Sum Length) -> Maybe (Sum Length) -> Maybe (Sum Length)
forall a. Semigroup a => a -> a -> a
<> (Length -> Sum Length
forall a. a -> Sum a
Sum (Length -> Sum Length) -> Maybe Length -> Maybe (Sum Length)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Length
mBR))
(Min Support -> Support
forall a. Min a -> a
getMin (Min Support -> Support) -> Maybe (Min Support) -> Maybe Support
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Support -> Min Support
forall a. a -> Min a
Min (Support -> Min Support) -> Maybe Support -> Maybe (Min Support)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Support
mSL) Maybe (Min Support) -> Maybe (Min Support) -> Maybe (Min Support)
forall a. Semigroup a => a -> a -> a
<> (Support -> Min Support
forall a. a -> Min a
Min (Support -> Min Support) -> Maybe Support -> Maybe (Min Support)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Support
mSR))
instance ToJSON Phylo
instance FromJSON Phylo
toPhyloTree :: (HasLength e, HasSupport e) => Tree e a -> Tree Phylo a
toPhyloTree :: Tree e a -> Tree Phylo a
toPhyloTree = (e -> Phylo) -> Tree e a -> Tree Phylo a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first e -> Phylo
forall e. (HasLength e, HasSupport e) => e -> Phylo
toPhyloLabel
toPhyloLabel :: (HasLength e, HasSupport e) => e -> Phylo
toPhyloLabel :: e -> Phylo
toPhyloLabel e
x = Maybe Length -> Maybe Support -> Phylo
Phylo (Length -> Maybe Length
forall a. a -> Maybe a
Just (Length -> Maybe Length) -> Length -> Maybe Length
forall a b. (a -> b) -> a -> b
$ e -> Length
forall e. HasLength e => e -> Length
getLen e
x) (Support -> Maybe Support
forall a. a -> Maybe a
Just (Support -> Maybe Support) -> Support -> Maybe Support
forall a b. (a -> b) -> a -> b
$ e -> Support
forall e. HasSupport e => e -> Support
getSup e
x)
measurableToPhyloTree :: HasLength e => Tree e a -> Tree Phylo a
measurableToPhyloTree :: Tree e a -> Tree Phylo a
measurableToPhyloTree = (e -> Phylo) -> Tree e a -> Tree Phylo a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first e -> Phylo
forall e. HasLength e => e -> Phylo
measurableToPhyloLabel
measurableToPhyloLabel :: HasLength e => e -> Phylo
measurableToPhyloLabel :: e -> Phylo
measurableToPhyloLabel e
x = Maybe Length -> Maybe Support -> Phylo
Phylo (Length -> Maybe Length
forall a. a -> Maybe a
Just (Length -> Maybe Length) -> Length -> Maybe Length
forall a b. (a -> b) -> a -> b
$ e -> Length
forall e. HasLength e => e -> Length
getLen e
x) Maybe Support
forall a. Maybe a
Nothing
supportedToPhyloTree :: HasSupport e => Tree e a -> Tree Phylo a
supportedToPhyloTree :: Tree e a -> Tree Phylo a
supportedToPhyloTree = (e -> Phylo) -> Tree e a -> Tree Phylo a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first e -> Phylo
forall e. HasSupport e => e -> Phylo
supportedToPhyloLabel
supportedToPhyloLabel :: HasSupport e => e -> Phylo
supportedToPhyloLabel :: e -> Phylo
supportedToPhyloLabel e
x = Maybe Length -> Maybe Support -> Phylo
Phylo Maybe Length
forall a. Maybe a
Nothing (Support -> Maybe Support
forall a. a -> Maybe a
Just (Support -> Maybe Support) -> Support -> Maybe Support
forall a b. (a -> b) -> a -> b
$ e -> Support
forall e. HasSupport e => e -> Support
getSup e
x)
phyloToLengthTree :: Tree Phylo a -> Either String (Tree Length a)
phyloToLengthTree :: Tree Phylo a -> Either String (Tree Length a)
phyloToLengthTree =
Either String (Tree Length a)
-> (Tree Length a -> Either String (Tree Length a))
-> Maybe (Tree Length a)
-> Either String (Tree Length a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String (Tree Length a)
forall a b. a -> Either a b
Left String
"phyloToLengthTree: Length unavailable for some branches.") Tree Length a -> Either String (Tree Length a)
forall a b. b -> Either a b
Right
(Maybe (Tree Length a) -> Either String (Tree Length a))
-> (Tree Phylo a -> Maybe (Tree Length a))
-> Tree Phylo a
-> Either String (Tree Length a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Phylo -> Maybe Length)
-> (a -> Maybe a) -> Tree Phylo a -> Maybe (Tree Length a)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Phylo -> Maybe Length
brLen a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Tree Phylo a -> Maybe (Tree Length a))
-> (Tree Phylo a -> Tree Phylo a)
-> Tree Phylo a
-> Maybe (Tree Length a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Phylo a -> Tree Phylo a
forall a. Tree Phylo a -> Tree Phylo a
cleanStemLength
cleanStemLength :: Tree Phylo a -> Tree Phylo a
cleanStemLength :: Tree Phylo a -> Tree Phylo a
cleanStemLength (Node (Phylo Maybe Length
Nothing Maybe Support
s) a
l Forest Phylo a
f) = Phylo -> a -> Forest Phylo a -> Tree Phylo a
forall e a. e -> a -> Forest e a -> Tree e a
Node (Maybe Length -> Maybe Support -> Phylo
Phylo (Length -> Maybe Length
forall a. a -> Maybe a
Just Length
0) Maybe Support
s) a
l Forest Phylo a
f
cleanStemLength Tree Phylo a
t = Tree Phylo a
t
phyloToSupportTree :: Tree Phylo a -> Either String (Tree Support a)
phyloToSupportTree :: Tree Phylo a -> Either String (Tree Support a)
phyloToSupportTree Tree Phylo a
t =
Either String (Tree Support a)
-> (Tree Support a -> Either String (Tree Support a))
-> Maybe (Tree Support a)
-> Either String (Tree Support a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(String -> Either String (Tree Support a)
forall a b. a -> Either a b
Left String
"phyloToSupportTree: Support value unavailable for some branches.")
Tree Support a -> Either String (Tree Support a)
forall a b. b -> Either a b
Right
(Maybe (Tree Support a) -> Either String (Tree Support a))
-> Maybe (Tree Support a) -> Either String (Tree Support a)
forall a b. (a -> b) -> a -> b
$ (Phylo -> Maybe Support)
-> (a -> Maybe a) -> Tree Phylo a -> Maybe (Tree Support a)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Phylo -> Maybe Support
brSup a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tree Phylo a -> Maybe (Tree Support a))
-> Tree Phylo a -> Maybe (Tree Support a)
forall a b. (a -> b) -> a -> b
$
Support -> Tree Phylo a -> Tree Phylo a
forall a. Support -> Tree Phylo a -> Tree Phylo a
cleanLeafSupport Support
m (Tree Phylo a -> Tree Phylo a) -> Tree Phylo a -> Tree Phylo a
forall a b. (a -> b) -> a -> b
$
Support -> Tree Phylo a -> Tree Phylo a
forall a. Support -> Tree Phylo a -> Tree Phylo a
cleanRootSupport Support
m Tree Phylo a
t
where
m :: Support
m = Tree Phylo a -> Support
forall a. Tree Phylo a -> Support
getMaxSupport Tree Phylo a
t
phyloToSupportTreeUnsafe :: Tree Phylo a -> Tree Support a
phyloToSupportTreeUnsafe :: Tree Phylo a -> Tree Support a
phyloToSupportTreeUnsafe Tree Phylo a
t = Support -> Tree Phylo a -> Tree Support a
forall a. Support -> Tree Phylo a -> Tree Support a
cleanSupport Support
m Tree Phylo a
t
where
m :: Support
m = Tree Phylo a -> Support
forall a. Tree Phylo a -> Support
getMaxSupport Tree Phylo a
t
getMaxSupport :: Tree Phylo a -> Support
getMaxSupport :: Tree Phylo a -> Support
getMaxSupport = Maybe Support -> Support
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Support -> Support)
-> (Tree Phylo a -> Maybe Support) -> Tree Phylo a -> Support
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Support -> Maybe Support -> Maybe Support
forall a. Ord a => a -> a -> a
max (Support -> Maybe Support
forall a. a -> Maybe a
Just Support
1.0) (Maybe Support -> Maybe Support)
-> (Tree Phylo a -> Maybe Support) -> Tree Phylo a -> Maybe Support
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (Maybe Support) (Maybe Support) -> Maybe Support
forall (t :: * -> * -> *) a. (Bifoldable t, Ord a) => t a a -> a
bimaximum (Tree (Maybe Support) (Maybe Support) -> Maybe Support)
-> (Tree Phylo a -> Tree (Maybe Support) (Maybe Support))
-> Tree Phylo a
-> Maybe Support
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Phylo -> Maybe Support)
-> (a -> Maybe Support)
-> Tree Phylo a
-> Tree (Maybe Support) (Maybe Support)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Phylo -> Maybe Support
brSup (Maybe Support -> a -> Maybe Support
forall a b. a -> b -> a
const Maybe Support
forall a. Maybe a
Nothing)
cleanRootSupport :: Support -> Tree Phylo a -> Tree Phylo a
cleanRootSupport :: Support -> Tree Phylo a -> Tree Phylo a
cleanRootSupport Support
maxSup (Node (Phylo Maybe Length
b Maybe Support
Nothing) a
l Forest Phylo a
xs) = Phylo -> a -> Forest Phylo a -> Tree Phylo a
forall e a. e -> a -> Forest e a -> Tree e a
Node (Maybe Length -> Maybe Support -> Phylo
Phylo Maybe Length
b (Support -> Maybe Support
forall a. a -> Maybe a
Just Support
maxSup)) a
l Forest Phylo a
xs
cleanRootSupport Support
_ Tree Phylo a
t = Tree Phylo a
t
cleanLeafSupport :: Support -> Tree Phylo a -> Tree Phylo a
cleanLeafSupport :: Support -> Tree Phylo a -> Tree Phylo a
cleanLeafSupport Support
s (Node (Phylo Maybe Length
b Maybe Support
Nothing) a
l []) = Phylo -> a -> [Tree Phylo a] -> Tree Phylo a
forall e a. e -> a -> Forest e a -> Tree e a
Node (Maybe Length -> Maybe Support -> Phylo
Phylo Maybe Length
b (Support -> Maybe Support
forall a. a -> Maybe a
Just Support
s)) a
l []
cleanLeafSupport Support
s (Node Phylo
b a
l [Tree Phylo a]
xs) = Phylo -> a -> [Tree Phylo a] -> Tree Phylo a
forall e a. e -> a -> Forest e a -> Tree e a
Node Phylo
b a
l ([Tree Phylo a] -> Tree Phylo a) -> [Tree Phylo a] -> Tree Phylo a
forall a b. (a -> b) -> a -> b
$ (Tree Phylo a -> Tree Phylo a) -> [Tree Phylo a] -> [Tree Phylo a]
forall a b. (a -> b) -> [a] -> [b]
map (Support -> Tree Phylo a -> Tree Phylo a
forall a. Support -> Tree Phylo a -> Tree Phylo a
cleanLeafSupport Support
s) [Tree Phylo a]
xs
cleanSupport :: Support -> Tree Phylo a -> Tree Support a
cleanSupport :: Support -> Tree Phylo a -> Tree Support a
cleanSupport Support
maxSup (Node (Phylo Maybe Length
_ Maybe Support
s) a
l Forest Phylo a
xs) = Support -> a -> Forest Support a -> Tree Support a
forall e a. e -> a -> Forest e a -> Tree e a
Node (Support -> Maybe Support -> Support
forall a. a -> Maybe a -> a
fromMaybe Support
maxSup Maybe Support
s) a
l (Forest Support a -> Tree Support a)
-> Forest Support a -> Tree Support a
forall a b. (a -> b) -> a -> b
$ (Tree Phylo a -> Tree Support a)
-> Forest Phylo a -> Forest Support a
forall a b. (a -> b) -> [a] -> [b]
map (Support -> Tree Phylo a -> Tree Support a
forall a. Support -> Tree Phylo a -> Tree Support a
cleanSupport Support
maxSup) Forest Phylo a
xs
data PhyloExplicit = PhyloExplicit
{ PhyloExplicit -> Length
sBrLen :: Length,
PhyloExplicit -> Support
sBrSup :: Support
}
deriving (ReadPrec [PhyloExplicit]
ReadPrec PhyloExplicit
Int -> ReadS PhyloExplicit
ReadS [PhyloExplicit]
(Int -> ReadS PhyloExplicit)
-> ReadS [PhyloExplicit]
-> ReadPrec PhyloExplicit
-> ReadPrec [PhyloExplicit]
-> Read PhyloExplicit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PhyloExplicit]
$creadListPrec :: ReadPrec [PhyloExplicit]
readPrec :: ReadPrec PhyloExplicit
$creadPrec :: ReadPrec PhyloExplicit
readList :: ReadS [PhyloExplicit]
$creadList :: ReadS [PhyloExplicit]
readsPrec :: Int -> ReadS PhyloExplicit
$creadsPrec :: Int -> ReadS PhyloExplicit
Read, Int -> PhyloExplicit -> ShowS
[PhyloExplicit] -> ShowS
PhyloExplicit -> String
(Int -> PhyloExplicit -> ShowS)
-> (PhyloExplicit -> String)
-> ([PhyloExplicit] -> ShowS)
-> Show PhyloExplicit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PhyloExplicit] -> ShowS
$cshowList :: [PhyloExplicit] -> ShowS
show :: PhyloExplicit -> String
$cshow :: PhyloExplicit -> String
showsPrec :: Int -> PhyloExplicit -> ShowS
$cshowsPrec :: Int -> PhyloExplicit -> ShowS
Show, PhyloExplicit -> PhyloExplicit -> Bool
(PhyloExplicit -> PhyloExplicit -> Bool)
-> (PhyloExplicit -> PhyloExplicit -> Bool) -> Eq PhyloExplicit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhyloExplicit -> PhyloExplicit -> Bool
$c/= :: PhyloExplicit -> PhyloExplicit -> Bool
== :: PhyloExplicit -> PhyloExplicit -> Bool
$c== :: PhyloExplicit -> PhyloExplicit -> Bool
Eq, Eq PhyloExplicit
Eq PhyloExplicit
-> (PhyloExplicit -> PhyloExplicit -> Ordering)
-> (PhyloExplicit -> PhyloExplicit -> Bool)
-> (PhyloExplicit -> PhyloExplicit -> Bool)
-> (PhyloExplicit -> PhyloExplicit -> Bool)
-> (PhyloExplicit -> PhyloExplicit -> Bool)
-> (PhyloExplicit -> PhyloExplicit -> PhyloExplicit)
-> (PhyloExplicit -> PhyloExplicit -> PhyloExplicit)
-> Ord PhyloExplicit
PhyloExplicit -> PhyloExplicit -> Bool
PhyloExplicit -> PhyloExplicit -> Ordering
PhyloExplicit -> PhyloExplicit -> PhyloExplicit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PhyloExplicit -> PhyloExplicit -> PhyloExplicit
$cmin :: PhyloExplicit -> PhyloExplicit -> PhyloExplicit
max :: PhyloExplicit -> PhyloExplicit -> PhyloExplicit
$cmax :: PhyloExplicit -> PhyloExplicit -> PhyloExplicit
>= :: PhyloExplicit -> PhyloExplicit -> Bool
$c>= :: PhyloExplicit -> PhyloExplicit -> Bool
> :: PhyloExplicit -> PhyloExplicit -> Bool
$c> :: PhyloExplicit -> PhyloExplicit -> Bool
<= :: PhyloExplicit -> PhyloExplicit -> Bool
$c<= :: PhyloExplicit -> PhyloExplicit -> Bool
< :: PhyloExplicit -> PhyloExplicit -> Bool
$c< :: PhyloExplicit -> PhyloExplicit -> Bool
compare :: PhyloExplicit -> PhyloExplicit -> Ordering
$ccompare :: PhyloExplicit -> PhyloExplicit -> Ordering
$cp1Ord :: Eq PhyloExplicit
Ord, (forall x. PhyloExplicit -> Rep PhyloExplicit x)
-> (forall x. Rep PhyloExplicit x -> PhyloExplicit)
-> Generic PhyloExplicit
forall x. Rep PhyloExplicit x -> PhyloExplicit
forall x. PhyloExplicit -> Rep PhyloExplicit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PhyloExplicit x -> PhyloExplicit
$cfrom :: forall x. PhyloExplicit -> Rep PhyloExplicit x
Generic)
instance Semigroup PhyloExplicit where
PhyloExplicit Length
bL Support
sL <> :: PhyloExplicit -> PhyloExplicit -> PhyloExplicit
<> PhyloExplicit Length
bR Support
sR = Length -> Support -> PhyloExplicit
PhyloExplicit (Length
bL Length -> Length -> Length
forall a. Num a => a -> a -> a
+ Length
bR) (Support -> Support -> Support
forall a. Ord a => a -> a -> a
min Support
sL Support
sR)
instance HasLength PhyloExplicit where
getLen :: PhyloExplicit -> Length
getLen = PhyloExplicit -> Length
sBrLen
setLen :: Length -> PhyloExplicit -> PhyloExplicit
setLen Length
b PhyloExplicit
pl = PhyloExplicit
pl {sBrLen :: Length
sBrLen = Length
b}
modLen :: (Length -> Length) -> PhyloExplicit -> PhyloExplicit
modLen Length -> Length
f (PhyloExplicit Length
l Support
s) = Length -> Support -> PhyloExplicit
PhyloExplicit (Length -> Length
f Length
l) Support
s
instance Splittable PhyloExplicit where
split :: PhyloExplicit -> PhyloExplicit
split PhyloExplicit
l = PhyloExplicit
l {sBrLen :: Length
sBrLen = Length
b'}
where
b' :: Length
b' = PhyloExplicit -> Length
sBrLen PhyloExplicit
l Length -> Length -> Length
forall a. Fractional a => a -> a -> a
/ Length
2.0
instance HasSupport PhyloExplicit where
getSup :: PhyloExplicit -> Support
getSup = PhyloExplicit -> Support
sBrSup
setSup :: Support -> PhyloExplicit -> PhyloExplicit
setSup Support
s PhyloExplicit
pl = PhyloExplicit
pl {sBrSup :: Support
sBrSup = Support
s}
modSup :: (Support -> Support) -> PhyloExplicit -> PhyloExplicit
modSup Support -> Support
f (PhyloExplicit Length
l Support
s) = Length -> Support -> PhyloExplicit
PhyloExplicit Length
l (Support -> Support
f Support
s)
instance ToJSON PhyloExplicit
instance FromJSON PhyloExplicit
toExplicitTree :: Tree Phylo a -> Either String (Tree PhyloExplicit a)
toExplicitTree :: Tree Phylo a -> Either String (Tree PhyloExplicit a)
toExplicitTree Tree Phylo a
t = do
Tree Length a
lt <- Tree Phylo a -> Either String (Tree Length a)
forall a. Tree Phylo a -> Either String (Tree Length a)
phyloToLengthTree Tree Phylo a
t
Tree Support a
st <- Tree Phylo a -> Either String (Tree Support a)
forall a. Tree Phylo a -> Either String (Tree Support a)
phyloToSupportTree Tree Phylo a
t
case (Length -> Support -> PhyloExplicit)
-> (a -> a -> a)
-> Tree Length a
-> Tree Support a
-> Maybe (Tree PhyloExplicit a)
forall e1 e2 e a1 a2 a.
(e1 -> e2 -> e)
-> (a1 -> a2 -> a) -> Tree e1 a1 -> Tree e2 a2 -> Maybe (Tree e a)
zipTreesWith Length -> Support -> PhyloExplicit
PhyloExplicit a -> a -> a
forall a b. a -> b -> a
const Tree Length a
lt Tree Support a
st of
Maybe (Tree PhyloExplicit a)
Nothing -> String -> Either String (Tree PhyloExplicit a)
forall a. HasCallStack => String -> a
error String
"toExplicitTree: Can not zip two trees with different topologies; please contact maintainer."
Just Tree PhyloExplicit a
zt -> Tree PhyloExplicit a -> Either String (Tree PhyloExplicit a)
forall (m :: * -> *) a. Monad m => a -> m a
return Tree PhyloExplicit a
zt