{-# LANGUAGE FlexibleInstances #-}
module ELynx.Data.Tree.PhyloTree
( PhyloLabel (..)
, PhyloIntLabel
, PhyloByteStringLabel
, removeBrLen
) where
import qualified Data.ByteString.Lazy.Builder as L
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Function
import Data.Tree
import Test.QuickCheck
import ELynx.Data.Tree.BranchSupportTree
import ELynx.Data.Tree.MeasurableTree
import ELynx.Data.Tree.NamedTree
data PhyloLabel a = PhyloLabel { pLabel :: a
, pBrSup :: Maybe Double
, pBrLen :: Double }
deriving (Read, Show, Eq)
instance Ord a => Ord (PhyloLabel a) where
compare = compare `on` pLabel
instance Measurable (PhyloLabel a) where
getLen = pBrLen
setLen l (PhyloLabel lbl s _)
| l >= 0 = PhyloLabel lbl s l
| otherwise = error "Branch lengths cannot be negative."
instance BranchSupportLabel (PhyloLabel a) where
getBranchSupport = pBrSup
setBranchSupport Nothing l = l {pBrSup = Nothing}
setBranchSupport (Just s) l
| s > 0 = l {pBrSup = Just s}
| otherwise = error "Branch support cannot be negative."
instance Arbitrary a => Arbitrary (PhyloLabel a) where
arbitrary = PhyloLabel
<$> arbitrary
<*> (Just <$> choose (0, 100))
<*> choose (0, 10)
type PhyloIntLabel = PhyloLabel Int
instance Named PhyloIntLabel where
getName = L.toLazyByteString . L.intDec . pLabel
type PhyloByteStringLabel = PhyloLabel L.ByteString
instance Named PhyloByteStringLabel where
getName = pLabel
removeBrLen :: Tree (PhyloLabel a) -> Tree a
removeBrLen = fmap pLabel