elynx-tree 0.7.2.2 → 0.9.0.0

raw patch · 23 files changed

+119/−110 lines, 23 filesdep −data-default-classdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: data-default-class

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• README.md +5/−5
• bench/Length.hs +5/−5
• bench/Lens.hs +5/−5
• bench/Tree.hs +1/−1
• elynx-tree.cabal +3/−3
• src/ELynx/Topology/Phylogeny.hs +4/−4
• src/ELynx/Topology/Rooted.hs +7/−8
• src/ELynx/Tree/Bipartition.hs +9/−9
• src/ELynx/Tree/Distance.hs +2/−2
• src/ELynx/Tree/Length.hs +11/−11
• src/ELynx/Tree/Mrca.hs +2/−2
• src/ELynx/Tree/Name.hs +1/−1
• src/ELynx/Tree/Parallel.hs +2/−2
• src/ELynx/Tree/Partition.hs +9/−9
• src/ELynx/Tree/Phylogeny.hs +14/−14
• src/ELynx/Tree/Rooted.hs +10/−11
• src/ELynx/Tree/Simulate/Coalescent.hs +2/−2
• src/ELynx/Tree/Simulate/PointProcess.hs +7/−7
• src/ELynx/Tree/Support.hs +4/−4
• test/ELynx/Topology/Arbitrary.hs +1/−1
• test/ELynx/Tree/PhylogenySpec.hs +2/−2
• test/ELynx/Tree/RootedSpec.hs +2/−2

@@ -5,6 +5,17 @@ ## Unreleased changes  +## Version 0.9.0.0++-   Toolchain update+-   Update to random version 1.3+++## Version 0.8.0.0++-   Adapt to breaking changes in upstream libraries (`data-default`).++ ## Version 0.7.2.0  -   `slynx`: Allow global normalization of mixture models.

@@ -2,7 +2,7 @@  # The ELynx Suite -Version: 0.7.2.1.+Version: 0.9.0.0. Reproducible evolution made easy.  <p align="center"><img src="https://travis-ci.org/dschrempf/elynx.svg?branch=master"/></p>@@ -73,9 +73,9 @@     # OR: stack exec slynx -- --help     # OR: slynx --help -    ELynx Suite version 0.7.2.1.+    ELynx Suite version 0.9.0.0.     Developed by Dominik Schrempf.-    Compiled on June 15, 2023, at 19:54 pm, UTC.+    Compiled on August 11, 2025, at 07:19 am, UTC.          Usage: slynx [-v|--verbosity VALUE] [-o|--output-file-basename NAME]                  [-f|--force] [--no-elynx-file] COMMAND@@ -143,9 +143,9 @@     # OR: stack exec slynx -- simulate --help     # OR: slynx simulate --help -    ELynx Suite version 0.7.2.1.+    ELynx Suite version 0.9.0.0.     Developed by Dominik Schrempf.-    Compiled on June 15, 2023, at 19:54 pm, UTC.+    Compiled on August 11, 2025, at 07:19 am, UTC.          Usage: slynx simulate (-t|--tree-file Name) [-s|--substitution-model MODEL]                           [-m|--mixture-model MODEL] [-n|--global-normalization]

@@ -51,17 +51,17 @@ doubleSum :: [Double] -> Double doubleSum = foldl' (+) 0 -fmapNormalFunctor :: HasLength a => Tree e a -> Tree e a+fmapNormalFunctor :: (HasLength a) => Tree e a -> Tree e a fmapNormalFunctor = fmap (modifyLength cos) -fmapFunctor :: HasLength e => Tree e a -> Tree e a+fmapFunctor :: (HasLength e) => Tree e a -> Tree e a fmapFunctor = getZipBranchTree . fmap (modifyLength cos) . ZipBranchTree -fmapBifunctor :: HasLength e => Tree e a -> Tree e a+fmapBifunctor :: (HasLength e) => Tree e a -> Tree e a fmapBifunctor = first (modifyLength cos) -totalBranchLengthFoldable :: HasLength e => Tree e a -> Length+totalBranchLengthFoldable :: (HasLength e) => Tree e a -> Length totalBranchLengthFoldable = totalBranchLength -totalBranchLengthBifoldable :: HasLength e => Tree e a -> Length+totalBranchLengthBifoldable :: (HasLength e) => Tree e a -> Length totalBranchLengthBifoldable = bifoldl' (+) const 0 . first getLength

@@ -21,17 +21,17 @@ import ELynx.Tree.Length import Lens.Micro -len :: HasLength a => Lens' a Length+len :: (HasLength a) => Lens' a Length len = lens getLength (flip setLength) -sumWithGetter :: HasLength a => [a] -> Length+sumWithGetter :: (HasLength a) => [a] -> Length sumWithGetter = foldl' (\x y -> x ^. len + y ^. len) 0 -sumWithSetter :: HasLength a => [a] -> Length+sumWithSetter :: (HasLength a) => [a] -> Length sumWithSetter = sumWithGetter . map (\x -> x & len %~ (+ 10)) -sumWithAccessorFunction :: HasLength a => [a] -> Length+sumWithAccessorFunction :: (HasLength a) => [a] -> Length sumWithAccessorFunction = foldl' (\x y -> getLength x + getLength y) 0 -sumWithModifyFunction :: HasLength a => [a] -> Length+sumWithModifyFunction :: (HasLength a) => [a] -> Length sumWithModifyFunction = sumWithAccessorFunction . map (modifyLength (+ 10))

@@ -29,7 +29,7 @@ fromMaybeWithError :: String -> Maybe a -> Either String a fromMaybeWithError s = maybe (Left s) Right -toLengthTreeBitraversable :: HasMaybeLength e => Tree e a -> Either String (Tree Length a)+toLengthTreeBitraversable :: (HasMaybeLength e) => Tree e a -> Either String (Tree Length a) toLengthTreeBitraversable t =   fromMaybeWithError "toLengthTree: Length unavailable for some branches." $ bisequenceA t'   where

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               elynx-tree-version:            0.7.2.2+version:            0.9.0.0 synopsis:           Handle phylogenetic trees description:   Examine, compare, and simulate phylogenetic trees in a reproducible way. Please see the README on GitHub at <https://github.com/dschrempf/elynx>.@@ -78,11 +78,11 @@   build-depends:     , aeson     , attoparsec-    , base+    , base        < 5     , bytestring     , comonad     , containers-    , data-default-class+    , data-default     , deepseq     , elynx-nexus     , math-functions

@@ -28,7 +28,7 @@   ) where -import Data.Default.Class+import Data.Default import Data.List hiding (intersect) import Data.Maybe import qualified Data.Set as S@@ -48,7 +48,7 @@   | otherwise = Right $ equal' tL tR  -- | Same as 'equal', but assume that leaves are unique.-equal' :: Eq a => Topology a -> Topology a -> Bool+equal' :: (Eq a) => Topology a -> Topology a -> Bool equal' (Leaf lbL) (Leaf lbR) =   lbL == lbR equal' (Node tsL) (Node tsR) =@@ -111,14 +111,14 @@ -- If the midpoint is ambiguous because the sum of the left and right depths is -- odd, the depth of the left sub-topology will be set to be one node greater -- than the one of the right sub-topology.-midpoint :: Default a => Topology a -> Either String (Topology a)+midpoint :: (Default a) => Topology a -> Either String (Topology a) midpoint = overTree T.midpoint  -- | For a rooted tree with a bifurcating root node, get all possible rooted -- trees. -- -- See 'ELynx.Tree.Phylogeny.roots'.-roots :: Default a => Topology a -> Either String [Topology a]+roots :: (Default a) => Topology a -> Either String [Topology a] roots = goBack . T.roots . goThere   where     -- We have to use a special 'overTree' function here, since a list of

@@ -41,7 +41,6 @@   ) where -import Control.Applicative import Control.DeepSeq import Control.Monad import Data.Aeson@@ -108,13 +107,13 @@   (Node ts) >>= f = Node $ fmap (>>= f) ts   (Leaf lb) >>= f = f lb -instance NFData a => NFData (Topology a) where+instance (NFData a) => NFData (Topology a) where   rnf (Node ts) = rnf ts   rnf (Leaf lb) = rnf lb -instance ToJSON a => ToJSON (Topology a)+instance (ToJSON a) => ToJSON (Topology a) -instance FromJSON a => FromJSON (Topology a)+instance (FromJSON a) => FromJSON (Topology a)  -- | Convert a rooted rose tree to a rooted topology. Internal node labels are lost. fromRoseTree :: T.Tree a -> Topology a@@ -146,27 +145,27 @@ --     squish (Node ts) xs = foldr squish xs ts --     squish (Leaf lb) xs = lb : xs -duplicates :: Ord a => [a] -> Bool+duplicates :: (Ord a) => [a] -> Bool duplicates = go S.empty   where     go _ [] = False     go seen (x : xs) = x `S.member` seen || go (S.insert x seen) xs  -- | Check if a topology has duplicate leaves.-duplicateLeaves :: Ord a => Topology a -> Bool+duplicateLeaves :: (Ord a) => Topology a -> Bool duplicateLeaves = duplicates . leaves  -- | Set leaf labels in pre-order. -- -- Return 'Nothing' if the provided list of leaf labels is too short.-setLeaves :: Traversable t => [b] -> t a -> Maybe (t b)+setLeaves :: (Traversable t) => [b] -> t a -> Maybe (t b) setLeaves xs = sequenceA . snd . mapAccumL setLeafM xs   where     setLeafM [] _ = ([], Nothing)     setLeafM (y : ys) _ = (ys, Just y)  -- | Label the leaves in pre-order with unique indices starting at 0.-identify :: Traversable t => t a -> t Int+identify :: (Traversable t) => t a -> t Int identify = snd . mapAccumL (\i _ -> (i + 1, i)) (0 :: Int)  -- | The degree of the root node.

@@ -85,7 +85,7 @@ -- Ensure that the larger set comes first. -- -- Return 'Left' if one set is empty.-bp :: Ord a => Set a -> Set a -> Either String (Bipartition a)+bp :: (Ord a) => Set a -> Set a -> Either String (Bipartition a) bp xs ys   | S.null xs = Left "bp: Left set empty."   | S.null ys = Left "bp: Right set empty."@@ -94,11 +94,11 @@ -- | Create a bipartition from two sets. -- -- Ensure that the larger set comes first.-bpUnsafe :: Ord a => Set a -> Set a -> Bipartition a+bpUnsafe :: (Ord a) => Set a -> Set a -> Bipartition a bpUnsafe xs ys = if xs >= ys then Bipartition (xs, ys) else Bipartition (ys, xs)  -- | Conversion to a set containing both partitions.-toSet :: Ord a => Bipartition a -> Set a+toSet :: (Ord a) => Bipartition a -> Set a toSet (Bipartition (x, y)) = S.union x y  -- I decided not to provide a human readable show instance because I need the@@ -112,11 +112,11 @@  -- | Show a bipartition in a human readable format. Use a provided function to -- extract information of interest.-bpHuman :: Show a => Bipartition a -> String+bpHuman :: (Show a) => Bipartition a -> String bpHuman (Bipartition (x, y)) = "(" ++ setShow x ++ "|" ++ setShow y ++ ")"  -- Show the elements of a set in a human readable format.-setShow :: Show a => Set a -> String+setShow :: (Show a) => Set a -> String setShow = intercalate "," . map show . S.toList  -- | For a bifurcating root, get the bipartition induced by the root node.@@ -124,14 +124,14 @@ -- Return 'Left' if -- - the root node is not bifurcating; -- - a leave set is empty.-bipartition :: Ord a => Tree e a -> Either String (Bipartition a)+bipartition :: (Ord a) => Tree e a -> Either String (Bipartition a) bipartition (Node _ _ [x, y]) = bp (S.fromList $ leaves x) (S.fromList $ leaves y) bipartition _ = Left "bipartition: Root node is not bifurcating."  -- | Get all bipartitions of the tree. -- -- Return 'Left' if the tree contains duplicate leaves.-bipartitions :: Ord a => Tree e a -> Either String (Set (Bipartition a))+bipartitions :: (Ord a) => Tree e a -> Either String (Set (Bipartition a)) bipartitions t   | duplicateLeaves t = Left "bipartitions: Tree contains duplicate leaves."   | otherwise = Right $ bipartitions' S.empty $ S.fromList <$> groups t@@ -146,7 +146,7 @@   [Set a] getComplementaryLeaves p (Node _ _ ts) =   [ S.unions $ p : take i lvsChildren ++ drop (i + 1) lvsChildren-    | i <- [0 .. (n - 1)]+  | i <- [0 .. (n - 1)]   ]   where     n = length ts@@ -154,7 +154,7 @@  -- See 'bipartitions', but do not check if leaves are unique, nor if -- bipartitions are valid.-bipartitions' :: Ord a => Set a -> Tree e (Set a) -> Set (Bipartition a)+bipartitions' :: (Ord a) => Set a -> Tree e (Set a) -> Set (Bipartition a) bipartitions' p (Node _ p' []) = either (const S.empty) S.singleton $ bp p p' bipartitions' p t@(Node _ p' ts) =   S.unions $

@@ -41,7 +41,7 @@ import ELynx.Tree.Rooted  -- Symmetric difference between two 'Set's.-symmetricDifference :: Ord a => Set a -> Set a -> Set a+symmetricDifference :: (Ord a) => Set a -> Set a -> Set a symmetricDifference xs ys = S.difference xs ys `S.union` S.difference ys xs  -- | Symmetric (Robinson-Foulds) distance between two trees.@@ -52,7 +52,7 @@ -- Return 'Nothing' if the trees contain different leaves. -- -- XXX: Comparing a list of trees recomputes bipartitions.-symmetric :: Ord a => Tree e1 a -> Tree e2 a -> Either String Int+symmetric :: (Ord a) => Tree e1 a -> Tree e2 a -> Either String Int symmetric t1 t2   | S.fromList (leaves t1) /= S.fromList (leaves t2) =       Left "symmetric: Trees contain different leaves."

@@ -39,7 +39,7 @@ import Control.DeepSeq import Data.Aeson import Data.Bifunctor-import Data.Default.Class+import Data.Default import Data.Foldable import Data.Semigroup import ELynx.Tree.Rooted@@ -122,7 +122,7 @@   getMaybeLength = const Nothing  -- | Class of data types with measurable and modifiable length.-class HasMaybeLength e => HasLength e where+class (HasMaybeLength e) => HasLength e where   getLength :: e -> Length   setLength :: Length -> e -> e   modifyLength :: (Length -> Length) -> e -> e@@ -130,33 +130,33 @@ -- | The maximum distance between origin and leaves. -- -- The height includes the branch length of the stem.-height :: HasLength e => Tree e a -> Length+height :: (HasLength e) => Tree e a -> Length height = maximum . distancesOriginLeaves  -- | The maximum distance between root node and leaves.-rootHeight :: HasLength e => Tree e a -> Length+rootHeight :: (HasLength e) => Tree e a -> Length rootHeight (Node _ _ []) = 0 rootHeight t = maximum $ concatMap distancesOriginLeaves (forest t)  -- | Distances from the origin of a tree to the leaves. -- -- The distances include the branch length of the stem.-distancesOriginLeaves :: HasLength e => Tree e a -> [Length]+distancesOriginLeaves :: (HasLength e) => Tree e a -> [Length] distancesOriginLeaves (Node br _ []) = [getLength br] distancesOriginLeaves (Node br _ ts) = map (getLength br +) (concatMap distancesOriginLeaves ts)  -- | Total branch length of a tree.-totalBranchLength :: HasLength e => Tree e a -> Length+totalBranchLength :: (HasLength e) => Tree e a -> Length totalBranchLength = foldl' (+) 0 . fmap getLength . ZipBranchTree  -- | Normalize branch lengths so that the sum is 1.0.-normalizeBranchLengths :: HasLength e => Tree e a -> Tree e a+normalizeBranchLengths :: (HasLength e) => Tree e a -> Tree e a normalizeBranchLengths t = first (modifyLength (/ s)) t   where     s = totalBranchLength t  -- | Normalize height of tree to 1.0.-normalizeHeight :: HasLength e => Tree e a -> Tree e a+normalizeHeight :: (HasLength e) => Tree e a -> Tree e a normalizeHeight t = first (modifyLength (/ h)) t   where     h = height t@@ -171,14 +171,14 @@     x = head xs  -- | Check if a tree is ultrametric.-ultrametric :: HasLength e => Tree e a -> Bool+ultrametric :: (HasLength e) => Tree e a -> Bool ultrametric = allNearlyEqual . distancesOriginLeaves  -- | Elongate terminal branches such that the tree becomes ultrametric.-makeUltrametric :: HasLength e => Tree e a -> Tree e a+makeUltrametric :: (HasLength e) => Tree e a -> Tree e a makeUltrametric t = go 0 t   where     h = height t-    go :: HasLength e => Length -> Tree e a -> Tree e a+    go :: (HasLength e) => Length -> Tree e a -> Tree e a     go h' (Node br lb []) = let dh = h - h' - getLength br in Node (modifyLength (+ dh) br) lb []     go h' (Node br lb ts) = let h'' = h' + getLength br in Node br lb $ map (go h'') ts

@@ -28,7 +28,7 @@ import ELynx.Tree.Zipper  -- | Test if the root node of the given tree is an ancestor of the given leaves.-isAncestor :: Ord a => S.Set a -> Tree e a -> Bool+isAncestor :: (Ord a) => S.Set a -> Tree e a -> Bool --                      True if an x of xs is not in the collection of leaves. --                False      if an x of xs is not in the collection of leaves. -> OK. isAncestor xs t = not $ any (`S.notMember` lvs) xs@@ -36,7 +36,7 @@     lvs = S.fromList $ leaves t  -- | Test if the root node of the given tree is the MRCA of the given leaves.-isMrca :: Ord a => S.Set a -> Tree e a -> Bool+isMrca :: (Ord a) => S.Set a -> Tree e a -> Bool --                                    True if any daughter forest is an ancestor. --                               False     if any daughter forest is an ancestor. -> OK. isMrca xs t = isAncestor xs t && not (any (isAncestor xs) (forest t))

@@ -24,7 +24,7 @@ import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BL-import Data.Default.Class+import Data.Default import Data.String  -- | Node name.

@@ -59,7 +59,7 @@ -- @  -- | Map and fold over branches. Evaluate the sub trees up to given layer in parallel.-parBranchFoldMap :: NFData f => Int -> (e -> f) -> (f -> f -> f) -> Tree e a -> f+parBranchFoldMap :: (NFData f) => Int -> (e -> f) -> (f -> f -> f) -> Tree e a -> f parBranchFoldMap n f op t@(Node br _ ts)   | n >= 1 = foldl' op (f br) (map (parBranchFoldMap (n - 1) f op) ts `using` myParList rdeepseq)   | otherwise = branchFoldMap f op t@@ -68,7 +68,7 @@ nodeFoldMap f op (Node _ lb ts) = foldl' op (f lb) $ map (nodeFoldMap f op) ts  -- | Map and fold over labels. Evaluate the sub trees up to given layer in parallel.-parLabelFoldMap :: NFData b => Int -> (a -> b) -> (b -> b -> b) -> Tree e a -> b+parLabelFoldMap :: (NFData b) => Int -> (a -> b) -> (b -> b -> b) -> Tree e a -> b parLabelFoldMap n f op t@(Node _ lb ts)   | n >= 1 = foldl' op (f lb) (map (parLabelFoldMap (n - 1) f op) ts `using` myParList rdeepseq)   | otherwise = nodeFoldMap f op t

@@ -56,17 +56,17 @@   deriving (Eq, Ord, Show, Read)  -- | Create a partition.-pt :: Ord a => [Set a] -> Either String (Partition a)+pt :: (Ord a) => [Set a] -> Either String (Partition a) pt xs = case filter (not . S.null) xs of   [] -> Left "pt: Empty list."   xs' -> Right $ ptUnsafe xs'  -- | Create a partition.-ptUnsafe :: Ord a => [Set a] -> Partition a+ptUnsafe :: (Ord a) => [Set a] -> Partition a ptUnsafe xs = Partition (S.fromList xs)  -- | Convert a bipartition to a partition.-bpToPt :: Ord a => Bipartition a -> Partition a+bpToPt :: (Ord a) => Bipartition a -> Partition a bpToPt = ptUnsafe . tupleToList . fromBipartition   where     -- Be careful with tuples, because 'toList' does something very weird. It only@@ -77,12 +77,12 @@  -- | Show a partition in a human readable form. Use a provided function to -- extract the valuable information.-ptHuman :: Show a => Partition a -> String+ptHuman :: (Show a) => Partition a -> String ptHuman (Partition xs) =   "(" ++ intercalate "|" (map setShow (S.toList xs)) ++ ")"  -- Show the elements of a set in a human readable format.-setShow :: Show a => Set a -> String+setShow :: (Show a) => Set a -> String setShow = intercalate "," . map show . S.toList  -- | Get partition defined by the root of the tree.@@ -90,7 +90,7 @@ -- Return 'Left' if: -- - the tree is a leaf; -- - the tree contains duplicate leaves.-partition :: Ord a => Tree e a -> Either String (Partition a)+partition :: (Ord a) => Tree e a -> Either String (Partition a) partition (Node _ _ []) = Left "partition: Encountered a leaf." partition t@(Node _ _ ts)   | duplicateLeaves t = Left "partition: Tree contains duplicate leaves."@@ -99,13 +99,13 @@ -- | Get all 'Partition's of a tree. -- -- Return 'Left' if tree contains duplicate leaves.-partitions :: Ord a => Tree e a -> Either String (Set (Partition a))+partitions :: (Ord a) => Tree e a -> Either String (Set (Partition a)) partitions t   | duplicateLeaves t = Left "partitions: Tree contains duplicate leaves."   | otherwise = Right $ partitions' S.empty $ S.fromList <$> groups t  -- See 'partitions', but do not check if leaves are unique.-partitions' :: Ord a => Set a -> Tree e (Set a) -> Set (Partition a)+partitions' :: (Ord a) => Set a -> Tree e (Set a) -> Set (Partition a) partitions' _ (Node _ _ []) = S.empty partitions' p t@(Node _ _ ts) =   S.unions $@@ -134,5 +134,5 @@     ls = fromPartition l     rs = fromPartition r -remove :: Ord a => Set a -> Set (Set a) -> Bool+remove :: (Ord a) => Set a -> Set (Set a) -> Bool remove s = not . any (s `S.isSubsetOf`)

@@ -72,7 +72,7 @@ import Control.DeepSeq import Data.Aeson import Data.Bifunctor-import Data.Default.Class+import Data.Default import Data.List hiding (intersect) import Data.Maybe import Data.Monoid@@ -218,7 +218,7 @@ midpoint t = roots t >>= getMidpoint  -- Find the index of the smallest element.-findMinIndex :: Ord a => [a] -> Either String Int+findMinIndex :: (Ord a) => [a] -> Either String Int findMinIndex (x : xs) = go (0, x) 1 xs   where     go (i, _) _ [] = Right i@@ -226,7 +226,7 @@     go (i, z) j (y : ys) = if z < y then go (i, z) (j + 1) ys else go (j, y) (j + 1) ys findMinIndex [] = Left "findMinIndex: Empty list." -getMidpoint :: HasLength e => [Tree e a] -> Either String (Tree e a)+getMidpoint :: (HasLength e) => [Tree e a] -> Either String (Tree e a) getMidpoint ts = case t of   Right (Node br lb [l, r]) ->     let hl = height l@@ -255,7 +255,7 @@             _ -> x'  -- Get delta height of left and right sub tree.-getDeltaHeight :: HasLength e => Tree e a -> Length+getDeltaHeight :: (HasLength e) => Tree e a -> Length getDeltaHeight (Node _ _ [l, r]) = abs $ height l - height r getDeltaHeight _ = error "getDeltaHeight: Root node is not bifurcating?" @@ -302,11 +302,11 @@ descend _ _ _ (Node _ _ []) = [] descend brR lbR tC (Node brD lbD tsD) =   [ Node brR lbR [Node (split brDd) lbD f, Node (split brDd) lbDd tsDd]-    | (Node brDd lbDd tsDd, f) <- zip tsD cfs+  | (Node brDd lbDd tsDd, f) <- zip tsD cfs   ]     ++ concat       [ descend brR lbR (Node (split brDd) lbD f) (Node (split brDd) lbDd tsDd)-        | (Node brDd lbDd tsDd, f) <- zip tsD cfs+      | (Node brDd lbDd tsDd, f) <- zip tsD cfs       ]   where     brC' = branch tC <> brD@@ -350,19 +350,19 @@ toPhyloTree = first toPhyloLabel  -- | Set branch length. Do not set support value.-lengthToPhyloLabel :: HasMaybeLength e => e -> Phylo+lengthToPhyloLabel :: (HasMaybeLength e) => e -> Phylo lengthToPhyloLabel x = Phylo (getMaybeLength x) Nothing  -- | See 'lengthToPhyloLabel'.-lengthToPhyloTree :: HasMaybeLength e => Tree e a -> Tree Phylo a+lengthToPhyloTree :: (HasMaybeLength e) => Tree e a -> Tree Phylo a lengthToPhyloTree = first lengthToPhyloLabel  -- | Set support value. Do not set branch length.-supportToPhyloLabel :: HasMaybeSupport e => e -> Phylo+supportToPhyloLabel :: (HasMaybeSupport e) => e -> Phylo supportToPhyloLabel x = Phylo Nothing (getMaybeSupport x)  -- | See 'supportToPhyloLabel'.-supportToPhyloTree :: HasMaybeSupport e => Tree e a -> Tree Phylo a+supportToPhyloTree :: (HasMaybeSupport e) => Tree e a -> Tree Phylo a supportToPhyloTree = first supportToPhyloLabel  fromMaybeWithError :: String -> Maybe a -> Either String a@@ -371,7 +371,7 @@ -- | If root branch length is not available, set it to 0. -- -- Return 'Left' if any other branch length is unavailable.-toLengthTree :: HasMaybeLength e => Tree e a -> Either String (Tree Length a)+toLengthTree :: (HasMaybeLength e) => Tree e a -> Either String (Tree Length a) toLengthTree (Node br lb ts) =   case traverse go ts of     Nothing -> Left "toLengthTree: Length unavailable for some branches."@@ -384,7 +384,7 @@ -- branch to maximum support. -- -- Return 'Left' if any other branch has no available support value.-toSupportTree :: HasMaybeSupport e => Tree e a -> Either String (Tree Support a)+toSupportTree :: (HasMaybeSupport e) => Tree e a -> Either String (Tree Support a) toSupportTree t@(Node br lb ts) =   fromMaybeWithError "toSupportTree: Support value unavailable for some branches." $     getBranchTree <$> sequenceA (BranchTree (Node br' lb $ map go ts))@@ -395,10 +395,10 @@     go (Node b l xs) = Node (getMaybeSupport b) l (map go xs)  -- If all branch support values are below 1.0, set the max support to 1.0.-getMaxSupport :: HasMaybeSupport e => Tree e a -> Support+getMaxSupport :: (HasMaybeSupport e) => Tree e a -> Support getMaxSupport = fromJust . max (Just 1.0) . maximum . fmap getMaybeSupport . ZipBranchTree -cleanSupportWith :: HasMaybeSupport e => Support -> e -> Maybe Support+cleanSupportWith :: (HasMaybeSupport e) => Support -> e -> Maybe Support cleanSupportWith m x = case getMaybeSupport x of   Nothing -> Just m   Just y -> Just y

@@ -98,7 +98,6 @@   ) where -import Control.Applicative import Control.Comonad import Control.DeepSeq import Control.Monad@@ -248,14 +247,14 @@     squish (Node _ lb []) xs = lb : xs     squish (Node _ _ ts) xs = foldr squish xs ts -duplicates :: Ord a => [a] -> Bool+duplicates :: (Ord a) => [a] -> Bool duplicates = go S.empty   where     go _ [] = False     go seen (x : xs) = x `S.member` seen || go (S.insert x seen) xs  -- | Check if a tree has duplicate leaves.-duplicateLeaves :: Ord a => Tree e a -> Bool+duplicateLeaves :: (Ord a) => Tree e a -> Bool duplicateLeaves = duplicates . leaves  -- | Set the stem to a given value.@@ -275,7 +274,7 @@ -- | Set branch labels in pre-order. -- -- Return 'Nothing' if the provided list of branch labels is too short.-setBranches :: Bitraversable t => [f] -> t e a -> Maybe (t f a)+setBranches :: (Bitraversable t) => [f] -> t e a -> Maybe (t f a) setBranches xs = bisequenceA . snd . bimapAccumL setBranch noChange xs   where     setBranch [] _ = ([], Nothing)@@ -297,20 +296,20 @@     squish (Node _ lb ts) xs = lb : foldr squish xs ts  -- | Check if a tree has duplicate labels.-duplicateLabels :: Ord a => Tree e a -> Bool+duplicateLabels :: (Ord a) => Tree e a -> Bool duplicateLabels = duplicates . labels  -- | Set node labels in pre-order. -- -- Return 'Nothing' if the provided list of node labels is too short.-setLabels :: Traversable t => [b] -> t a -> Maybe (t b)+setLabels :: (Traversable t) => [b] -> t a -> Maybe (t b) setLabels xs = sequenceA . snd . mapAccumL setLabelM xs   where     setLabelM [] _ = ([], Nothing)     setLabelM (y : ys) _ = (ys, Just y)  -- | Label the nodes in pre-order with unique indices starting at 0.-identify :: Traversable t => t a -> t Int+identify :: (Traversable t) => t a -> t Int identify = snd . mapAccumL (\i _ -> (i + 1, i)) (0 :: Int)  -- | Degree of the root node.@@ -338,7 +337,7 @@ -- their 'Semigroup' instance of the form -- -- @\daughterBranch parentBranch -> combinedBranch@.-prune :: Semigroup e => Tree e a -> Tree e a+prune :: (Semigroup e) => Tree e a -> Tree e a prune t@(Node _ _ []) = t prune (Node paBr _ [Node daBr daLb daTs]) = Node (daBr <> paBr) daLb daTs prune (Node paBr paLb paTs) = Node paBr paLb $ map prune paTs@@ -445,7 +444,7 @@         map (getBranchTree . duplicate . BranchTree) ts   extract = branch . getBranchTree -instance Monoid a => Applicative (BranchTree a) where+instance (Monoid a) => Applicative (BranchTree a) where   -- Infinite layers with infinite subtrees.   pure br = BranchTree $ Node br mempty []   (BranchTree ~(Node brF lbF tsF)) <*> tx@(BranchTree ~(Node brX lbX tsX)) =@@ -512,7 +511,7 @@ -- >>> f <*> t -- -- ZipTree {getZipTree = Node {branch = "+3", label = 3, forest = [Node {branch = "*5", label = 5, forest = []},Node {branch = "+10", label = 12, forest = []}]}}-instance Monoid e => Applicative (ZipTree e) where+instance (Monoid e) => Applicative (ZipTree e) where   -- Infinite layers with infinite subtrees.   pure lb = ZipTree $ Node mempty lb $ repeat (getZipTree $ pure lb)   (ZipTree ~(Node brF lbF tsF)) <*> (ZipTree ~(Node brX lbX tsX)) =@@ -574,7 +573,7 @@   extract = branch . getZipBranchTree  -- | See the 'Applicative' instance of 'ZipTree'.-instance Monoid a => Applicative (ZipBranchTree a) where+instance (Monoid a) => Applicative (ZipBranchTree a) where   -- Infinite layers with infinite subtrees.   pure br = ZipBranchTree $ Node br mempty $ repeat (getZipBranchTree $ pure br)   (ZipBranchTree ~(Node brF lbF tsF)) <*> (ZipBranchTree ~(Node brX lbX tsX)) =

@@ -23,7 +23,7 @@ -- | Simulate a coalescent tree with @n@ leaves. The branch lengths are in units -- of effective population size. simulate ::-  StatefulGen g m =>+  (StatefulGen g m) =>   -- | Number of leaves.   Int ->   g ->@@ -33,7 +33,7 @@     trs = [Node 0 i [] | i <- [0 .. n - 1]]  simulate' ::-  StatefulGen g m =>+  (StatefulGen g m) =>   Int ->   Int ->   Forest Length Int ->

@@ -60,11 +60,11 @@ x =~= y = eps > abs (x - y)  -- Sort a list and also return original indices.-sortListWithIndices :: Ord a => [a] -> [(a, Int)]+sortListWithIndices :: (Ord a) => [a] -> [(a, Int)] sortListWithIndices xs = sortBy (compare `on` fst) $ zip xs ([0 ..] :: [Int])  -- Insert element into random position of list.-randomInsertList :: StatefulGen g m => a -> [a] -> g -> m [a]+randomInsertList :: (StatefulGen g m) => a -> [a] -> g -> m [a] randomInsertList e v g = do   let l = length v   i <- uniformRM (0, l) g@@ -95,7 +95,7 @@ -- | Sample a point process using the 'BirthDeathDistribution'. The names of the -- points will be integers. simulate ::-  StatefulGen g m =>+  (StatefulGen g m) =>   -- | Number of points (samples).   Int ->   -- | Time of origin or MRCA.@@ -117,7 +117,7 @@ -- No time of origin given. We also don't need to take care of the conditioning -- (origin or MRCA). simulateRandom ::-  StatefulGen g m =>+  (StatefulGen g m) =>   Int ->   Double ->   Double ->@@ -149,7 +149,7 @@  -- Time of origin is given. simulateOrigin ::-  StatefulGen g m =>+  (StatefulGen g m) =>   Int ->   Time ->   Double ->@@ -178,7 +178,7 @@  -- Time of Mrca is given. simulateMrca ::-  StatefulGen g m =>+  (StatefulGen g m) =>   Int ->   Time ->   Double ->@@ -243,7 +243,7 @@ -- 'toReconstructedTree') possibly with specific height and a fixed number of -- leaves according to the birth and death process. simulateReconstructedTree ::-  StatefulGen g m =>+  (StatefulGen g m) =>   -- | Number of points (samples)   Int ->   -- | Time of origin or MRCA

@@ -80,14 +80,14 @@   getMaybeSupport :: e -> Maybe Support  -- | Class of data types with measurable and modifiable support values.-class HasMaybeSupport e => HasSupport e where+class (HasMaybeSupport e) => HasSupport e where   getSupport :: e -> Support   setSupport :: Support -> e -> e   modifySupport :: (Support -> Support) -> e -> e  -- | Normalize branch support values. The maximum branch support value will be -- set to 1.0.-normalizeBranchSupport :: HasSupport e => Tree e a -> Tree e a+normalizeBranchSupport :: (HasSupport e) => Tree e a -> Tree e a normalizeBranchSupport t = first (modifySupport (/ m)) t   where     m = maximum $ getSupport <$> ZipBranchTree t@@ -101,12 +101,12 @@    in if tr == tr' then tr else collapse th tr'  -- A leaf has full support.-highP :: HasSupport e => Support -> Tree e a -> Bool+highP :: (HasSupport e) => Support -> Tree e a -> Bool highP _ (Node _ _ []) = True highP th (Node br _ _) = getSupport br >= th  -- See 'collapse'.-collapse' :: HasSupport e => Support -> Tree e a -> Tree e a+collapse' :: (HasSupport e) => Support -> 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

@@ -40,7 +40,7 @@           rest <- arbPartition $ k - first           return $ first : rest -instance Arbitrary a => Arbitrary (Topology a) where+instance (Arbitrary a) => Arbitrary (Topology a) where   arbitrary = arbitrary1  instance (CoArbitrary a) => CoArbitrary (Topology a) where

@@ -51,13 +51,13 @@     Node () "i" [Node () "j" [Node () "z" [], Node () "x" []], Node () "y" []]   ] -prop_roots :: Default a => Tree () a -> Bool+prop_roots :: (Default a) => Tree () a -> Bool prop_roots t@(Node _ _ []) = isLeft $ roots t prop_roots t@(Node _ _ [_]) = isLeft $ roots t prop_roots t@(Node _ _ [_, _]) = (length <$> roots t) == Right (length (labels t) - 2) prop_roots t = (length <$> roots t) == Right (length (labels t) - 1) -prop_roots_total_length :: Default a => Tree Length a -> Bool+prop_roots_total_length :: (Default a) => Tree Length a -> Bool prop_roots_total_length t@(Node _ _ [_, _]) =   all (\x -> abs (totalBranchLength x - l) < 1e-8) $     either error id $

@@ -59,7 +59,7 @@ -- Check that the Traversable instances of Tree and BranchTree work the same. I -- am pretty confident that the Traversable instance of Tree is correct, so this -- should be enough.-prop_BranchTree_traversable :: Eq e => Tree e a -> Bool+prop_BranchTree_traversable :: (Eq e) => Tree e a -> Bool prop_BranchTree_traversable t = identify t == bt   where     bt = flipLabels $ getBranchTree $ identify $ BranchTree $ flipLabels t@@ -76,7 +76,7 @@     znt' = (,) <$> znt <*> znt  -- Same as above but for zip trees.-prop_ZipTrees_traversable :: Eq e => Tree e a -> Bool+prop_ZipTrees_traversable :: (Eq e) => Tree e a -> Bool prop_ZipTrees_traversable t = (t' == zbt) && (t' == znt)   where     t' = identify t