{-# LANGUAGE FlexibleInstances #-}
module ELynx.Data.Tree.PhyloTree
( PhyloLabel (..)
, removeBrInfo
) where
import Data.Function
import Data.Maybe (fromMaybe)
import Data.Tree
import Test.QuickCheck hiding (label)
import ELynx.Data.Tree.BranchSupportTree
import ELynx.Data.Tree.MeasurableTree
import ELynx.Data.Tree.NamedTree
data PhyloLabel a = PhyloLabel { label :: a
, brSup :: Maybe Double
, brLen :: Maybe Double }
deriving (Read, Show, Eq)
instance Ord a => Ord (PhyloLabel a) where
compare = compare `on` label
instance Measurable (PhyloLabel a) where
getLen = fromMaybe 0 . brLen
setLen l x
| l >= 0 = x {brLen = Just l}
| otherwise = error $ "Branch lengths cannot be negative: " <> show l
instance BranchSupported (PhyloLabel a) where
getBranchSupport = brSup
setBranchSupport Nothing l = l {brSup = Nothing}
setBranchSupport (Just s) l
| s > 0 = l {brSup = Just s}
| otherwise = error "Branch support cannot be negative."
instance Arbitrary a => Arbitrary (PhyloLabel a) where
arbitrary = PhyloLabel
<$> arbitrary
<*> (Just <$> choose (0, 100))
<*> (Just <$> choose (0, 10) )
instance Named a => Named (PhyloLabel a) where
getName = getName . label
removeBrInfo :: Tree (PhyloLabel a) -> Tree a
removeBrInfo = fmap label