elynx-tree 0.4.1 → 0.5.0

raw patch · 30 files changed

+620/−320 lines, 30 filesdep +microlensPVP ok

version bump matches the API change (PVP)

Dependencies added: microlens

API changes (from Hackage documentation)

Files

• ChangeLog.md +10/−0
• README.md +27/−27
• bench/Bench.hs +59/−5
• bench/Length.hs +37/−0
• bench/Lens.hs +37/−0
• elynx-tree.cabal +5/−1
• src/ELynx/Topology.hs +24/−0
• src/ELynx/Tree.hs +3/−4
• src/ELynx/Tree/Distance.hs +4/−6
• src/ELynx/Tree/Export/Newick.hs +16/−6
• src/ELynx/Tree/Import/Newick.hs +45/−39
• src/ELynx/Tree/Import/Nexus.hs +4/−3
• src/ELynx/Tree/Measurable.hs +92/−43
• src/ELynx/Tree/Named.hs +38/−9
• src/ELynx/Tree/Phylogeny.hs +66/−90
• src/ELynx/Tree/Rooted.hs +30/−15
• src/ELynx/Tree/Simulate/Coalescent.hs +3/−4
• src/ELynx/Tree/Simulate/PointProcess.hs +8/−8
• src/ELynx/Tree/Supported.hs +58/−18
• src/ELynx/Tree/Zipper.hs +25/−9
• test/ELynx/Tree/Arbitrary.hs +5/−2
• test/ELynx/Tree/BipartitionSpec.hs +5/−6
• test/ELynx/Tree/DistanceSpec.hs +7/−8
• test/ELynx/Tree/Export/NewickSpec.hs +2/−3
• test/ELynx/Tree/Export/NexusSpec.hs +1/−2
• test/ELynx/Tree/Import/NewickSpec.hs +1/−1
• test/ELynx/Tree/Import/NexusSpec.hs +1/−2
• test/ELynx/Tree/PhylogenySpec.hs +2/−2
• test/ELynx/Tree/RootedSpec.hs +3/−4
• test/ELynx/Tree/SupportedSpec.hs +2/−3

@@ -5,6 +5,16 @@ ## Unreleased changes  +## Version 0.5.0++-   `modLen`, `modSup`.+-   Newtype wrappers for branch length, branch support, and node name. Those data+    types and some functions were also renamed.+-   Add `Path`, and `getSubTreeUnsafe` to tree zipper.+-   Rename `unsafe` functions so that `unsafe` is at the end.+-   Many small changes.++ ## Version 0.4.1  -   Improve `TimeSpec` (Point process).

@@ -2,7 +2,7 @@  # The ELynx Suite -Version: 0.4.1.+Version: 0.5.0. Reproducible evolution made easy.  <p align="center"><img src="https://travis-ci.org/dschrempf/elynx.svg?branch=master"/></p>@@ -90,9 +90,9 @@      slynx --help | head -n -16 -    ELynx Suite version 0.4.1.+    ELynx Suite version 0.5.0.     Developed by Dominik Schrempf.-    Compiled on October 16, 2020, at 12:46 pm, UTC.+    Compiled on November 10, 2020, at 14:29 pm, UTC.          Usage: slynx [-v|--verbosity VALUE] [-o|--output-file-basename NAME]                   [-f|--force] [--no-elynx-file] COMMAND@@ -137,9 +137,9 @@      slynx concatenate --help -    ELynx Suite version 0.4.1.+    ELynx Suite version 0.5.0.     Developed by Dominik Schrempf.-    Compiled on October 16, 2020, at 12:46 pm, UTC.+    Compiled on November 10, 2020, at 14:29 pm, UTC.          Usage: slynx concatenate (-a|--alphabet NAME) INPUT-FILE       Concatenate sequences found in input files.@@ -158,9 +158,9 @@      slynx examine --help -    ELynx Suite version 0.4.1.+    ELynx Suite version 0.5.0.     Developed by Dominik Schrempf.-    Compiled on October 16, 2020, at 12:46 pm, UTC.+    Compiled on November 10, 2020, at 14:29 pm, UTC.          Usage: slynx examine (-a|--alphabet NAME) INPUT-FILE [--per-site]       Examine sequences. If data is a multi sequence alignment, additionally analyze columns.@@ -180,9 +180,9 @@      slynx filter-rows --help -    ELynx Suite version 0.4.1.+    ELynx Suite version 0.5.0.     Developed by Dominik Schrempf.-    Compiled on October 16, 2020, at 12:46 pm, UTC.+    Compiled on November 10, 2020, at 14:29 pm, UTC.          Usage: slynx filter-rows (-a|--alphabet NAME) INPUT-FILE [--longer-than LENGTH]                               [--shorter-than LENGTH] [--standard-characters]@@ -203,9 +203,9 @@      slynx filter-columns --help -    ELynx Suite version 0.4.1.+    ELynx Suite version 0.5.0.     Developed by Dominik Schrempf.-    Compiled on October 16, 2020, at 12:46 pm, UTC.+    Compiled on November 10, 2020, at 14:29 pm, UTC.          Usage: slynx filter-columns (-a|--alphabet NAME) INPUT-FILE                                  [--standard-chars DOUBLE]@@ -227,9 +227,9 @@      slynx simulate --help -    ELynx Suite version 0.4.1.+    ELynx Suite version 0.5.0.     Developed by Dominik Schrempf.-    Compiled on October 16, 2020, at 12:46 pm, UTC.+    Compiled on November 10, 2020, at 14:29 pm, UTC.          Usage: slynx simulate (-t|--tree-file Name) [-s|--substitution-model MODEL]                            [-m|--mixture-model MODEL] [-e|--edm-file NAME] @@ -306,9 +306,9 @@      slynx sub-sample --help -    ELynx Suite version 0.4.1.+    ELynx Suite version 0.5.0.     Developed by Dominik Schrempf.-    Compiled on October 16, 2020, at 12:46 pm, UTC.+    Compiled on November 10, 2020, at 14:29 pm, UTC.          Usage: slynx sub-sample (-a|--alphabet NAME) INPUT-FILE                             (-n|--number-of-sites INT)@@ -336,9 +336,9 @@      slynx translate --help -    ELynx Suite version 0.4.1.+    ELynx Suite version 0.5.0.     Developed by Dominik Schrempf.-    Compiled on October 16, 2020, at 12:46 pm, UTC.+    Compiled on November 10, 2020, at 14:29 pm, UTC.          Usage: slynx translate (-a|--alphabet NAME) INPUT-FILE (-r|--reading-frame INT)                            (-u|--universal-code CODE)@@ -361,9 +361,9 @@      tlynx --help | head -n -16 -    ELynx Suite version 0.4.1.+    ELynx Suite version 0.5.0.     Developed by Dominik Schrempf.-    Compiled on October 16, 2020, at 12:46 pm, UTC.+    Compiled on November 10, 2020, at 14:29 pm, UTC.          Usage: tlynx [-v|--verbosity VALUE] [-o|--output-file-basename NAME]                   [-f|--force] [--no-elynx-file] COMMAND@@ -401,9 +401,9 @@      tlynx compare --help -    ELynx Suite version 0.4.1.+    ELynx Suite version 0.5.0.     Developed by Dominik Schrempf.-    Compiled on October 16, 2020, at 12:46 pm, UTC.+    Compiled on November 10, 2020, at 14:29 pm, UTC.          Usage: tlynx compare [-n|--normalize] [-b|--bipartitions] [-t|--intersect]                           [-f|--newick-format FORMAT] NAMES@@ -430,9 +430,9 @@      tlynx examine --help -    ELynx Suite version 0.4.1.+    ELynx Suite version 0.5.0.     Developed by Dominik Schrempf.-    Compiled on October 16, 2020, at 12:46 pm, UTC.+    Compiled on November 10, 2020, at 14:29 pm, UTC.          Usage: tlynx examine INPUT-FILE [-f|--newick-format FORMAT]       Compute summary statistics of phylogenetic trees.@@ -454,9 +454,9 @@      tlynx simulate --help -    ELynx Suite version 0.4.1.+    ELynx Suite version 0.5.0.     Developed by Dominik Schrempf.-    Compiled on October 16, 2020, at 12:46 pm, UTC.+    Compiled on November 10, 2020, at 14:29 pm, UTC.          Usage: tlynx simulate (-t|--nTrees INT) (-n|--nLeaves INT) PROCESS                            [-u|--sub-sample DOUBLE] [-s|--summary-statistics] @@ -491,9 +491,9 @@      elynx --help | head -n -16 -    ELynx Suite version 0.4.1.+    ELynx Suite version 0.5.0.     Developed by Dominik Schrempf.-    Compiled on October 16, 2020, at 12:46 pm, UTC.+    Compiled on November 10, 2020, at 14:29 pm, UTC.          Usage: elynx COMMAND       Validate and redo past ELynx analyses

@@ -16,29 +16,30 @@ import Control.Parallel.Strategies import Criterion.Main import Data.Bifunctor-import qualified Data.ByteString.Char8 as BS import Data.Foldable import ELynx.Tools hiding (Random) import ELynx.Tree import ELynx.Tree.Simulate.PointProcess+import Length+import Lens import System.Random.MWC  treeFileMany :: FilePath treeFileMany = "data/Many.trees" -getManyTrees :: IO (Forest Phylo BS.ByteString)+getManyTrees :: IO (Forest Phylo Name) getManyTrees = parseFileWith (someNewick Standard) treeFileMany  hugeTree :: IO (Tree Length Int) hugeTree = create >>= simulateReconstructedTree 50000 Random 1.0 0.9 -sinN :: Int -> Double -> Double+sinN :: Int -> Length -> Length sinN n x = iterate sin x !! n -func :: Double -> Double+func :: Length -> Length func = sinN 200 -hugeTreeCalcPar :: Int -> Tree Double Int -> Tree Double Int+hugeTreeCalcPar :: Int -> Tree Length Int -> Tree Length Int hugeTreeCalcPar n t = first func t `using` parTree n  main :: IO ()@@ -72,5 +73,58 @@         "fold strategies"         [ bench "sequential" $ nf (parBranchFoldMap 0 func (+)) ht,           bench "parallel 3" $ nf (parBranchFoldMap 3 func (+)) ht+        ],+      -- Unsafe operations are fast, safe operations are roughly 50 percent slower.+      bgroup+        "length"+        [ bench "length sum foldl' safe" $ nf lengthSumFoldl' [0 .. 10000000],+          bench "length sum foldl' unsafe" $ nf lengthSumFoldl'Unsafe [0 .. 10000000],+          bench "length sum foldl' num instance" $ nf lengthSumFoldl'NumInstance [0 .. 10000000],+          bench "double sum foldl'" $ nf doubleSumFoldl' [0 .. 10000000],+          bench "double sum" $ nf doubleSum [0 .. 10000000]+        ],+      -- Lenses are fast.+      bgroup+        "lens"+        [ bench "sum with getter" $ nf sumWithGetter [0 .. 1000000 :: Length],+          bench "sum with accessor function" $ nf sumWithAccessorFunction [0 .. 1000000 :: Length],+          bench "sum with setter and getter" $ nf sumWithSetter [0 .. 1000000 :: Length],+          bench "sum with modify and accessor functions" $ nf sumWithModifyFunction [0 .. 1000000 :: Length]         ]     ]++-- Results 2020 Nov 2, commit aee6818.++-- benchmarking bipartition/manyTrees+-- time                 9.631 ms   (9.583 ms .. 9.721 ms)+--                      0.998 R²   (0.995 R² .. 1.000 R²)+-- mean                 9.723 ms   (9.670 ms .. 9.879 ms)+-- std dev              220.5 μs   (87.68 μs .. 421.0 μs)++-- benchmarking map strategies/sequential+-- time                 851.4 ms   (666.8 ms .. 1.025 s)+--                      0.994 R²   (0.978 R² .. 1.000 R²)+-- mean                 735.3 ms   (676.0 ms .. 766.2 ms)+-- std dev              66.42 ms   (55.94 ms .. 69.47 ms)+-- variance introduced by outliers: 22% (moderately inflated)++-- benchmarking map strategies/parallel 3+-- time                 362.1 ms   (348.5 ms .. 377.0 ms)+--                      1.000 R²   (0.999 R² .. 1.000 R²)+-- mean                 354.6 ms   (348.1 ms .. 358.2 ms)+-- std dev              4.959 ms   (1.499 ms .. 6.727 ms)+-- variance introduced by outliers: 19% (moderately inflated)++-- benchmarking fold strategies/sequential+-- time                 762.0 ms   (682.7 ms .. 913.8 ms)+--                      0.995 R²   (0.992 R² .. 1.000 R²)+-- mean                 676.3 ms   (647.5 ms .. 720.1 ms)+-- std dev              42.34 ms   (11.72 ms .. 57.27 ms)+-- variance introduced by outliers: 19% (moderately inflated)++-- benchmarking fold strategies/parallel 3+-- time                 413.4 ms   (330.2 ms .. 536.7 ms)+--                      0.990 R²   (0.972 R² .. 1.000 R²)+-- mean                 368.3 ms   (345.6 ms .. 394.6 ms)+-- std dev              25.80 ms   (7.999 ms .. 35.08 ms)+-- variance introduced by outliers: 20% (moderately inflated)

@@ -0,0 +1,37 @@+-- |+-- Module      :  Length+-- Description :  Benchmark length newtype+-- Copyright   :  (c) Dominik Schrempf, 2020+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Tue Nov  3 13:42:00 2020.+module Length+  ( lengthSumFoldl',+    lengthSumFoldl'Unsafe,+    lengthSumFoldl'NumInstance,+    doubleSumFoldl',+    doubleSum,+  )+where++import Data.Foldable+import ELynx.Tree.Measurable++lengthSumFoldl' :: [Length] -> Length+lengthSumFoldl' = foldl' (\x y -> either error id $ toLength $ fromLength x + fromLength y) 0++lengthSumFoldl'Unsafe :: [Length] -> Length+lengthSumFoldl'Unsafe = foldl' (\x y -> toLengthUnsafe $ fromLength x + fromLength y) 0++lengthSumFoldl'NumInstance :: [Length] -> Length+lengthSumFoldl'NumInstance = foldl' (+) 0++doubleSumFoldl' :: [Double] -> Double+doubleSumFoldl' = foldl' (+) 0++doubleSum :: [Double] -> Double+doubleSum = foldl' (+) 0

@@ -0,0 +1,37 @@+-- |+-- Module      :  Lens+-- Description :  Benchmark lens operations+-- Copyright   :  (c) Dominik Schrempf, 2020+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Tue Nov  3 14:05:53 2020.+module Lens+  ( sumWithGetter,+    sumWithSetter,+    sumWithAccessorFunction,+    sumWithModifyFunction,+  )+where++import Data.Foldable+import ELynx.Tree.Measurable+import Lens.Micro++len :: Measurable a => Lens' a Length+len = lens getLen (flip setLen)++sumWithGetter :: Measurable a => [a] -> Length+sumWithGetter = foldl' (\x y -> x ^. len + y ^. len) 0++sumWithSetter :: Measurable a => [a] -> Length+sumWithSetter = sumWithGetter . map (\x -> x & len %~ (+ 10))++sumWithAccessorFunction :: Measurable a => [a] -> Length+sumWithAccessorFunction = foldl' (\x y -> getLen x + getLen y) 0++sumWithModifyFunction :: Measurable a => [a] -> Length+sumWithModifyFunction = sumWithAccessorFunction . map (modLen (+ 10))

@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           elynx-tree-version:        0.4.1+version:        0.5.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>. category:       Bioinformatics@@ -39,6 +39,7 @@  library   exposed-modules:+      ELynx.Topology       ELynx.Topology.Phylogeny       ELynx.Topology.Rooted       ELynx.Tree@@ -126,6 +127,8 @@   type: exitcode-stdio-1.0   main-is: Bench.hs   other-modules:+      Length+      Lens       Paths_elynx_tree   hs-source-dirs:       bench@@ -138,6 +141,7 @@     , deepseq     , elynx-tools     , elynx-tree+    , microlens     , mwc-random     , parallel   default-language: Haskell2010

@@ -0,0 +1,24 @@+-- |+-- Module      :  ELynx.Topology+-- Description :  Rooted topologies+-- Copyright   :  (c) Dominik Schrempf, 2020+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Tue Oct 27 14:58:25 2020.+--+-- Convenience module combining all topology modules.+module ELynx.Topology+  ( -- * Rooted topologies+    module ELynx.Topology.Rooted,++    -- * Phylogenetics+    module ELynx.Topology.Phylogeny,+  )+where++import ELynx.Topology.Phylogeny+import ELynx.Topology.Rooted

@@ -1,9 +1,6 @@--- TODO: Topology data type.--- data Topology a = Node (NonEmptySet (Topology a)) | Leaf a- -- | -- Module      :  ELynx.Tree--- Description :  Phylogenetic trees+-- Description :  Rooted trees -- Copyright   :  (c) Dominik Schrempf 2020 -- License     :  GPL-3.0-or-later --@@ -12,6 +9,8 @@ -- Portability :  portable -- -- Creation date: Sat Mar 21 16:27:20 2020.+--+-- Convenience module combining all tree modules. module ELynx.Tree   ( -- * Rooted trees     module ELynx.Tree.Rooted,

@@ -29,8 +29,6 @@   ) where --- adjacent,- import Data.Bifunctor import Data.List import qualified Data.Map as M@@ -53,7 +51,7 @@ -- -- Return 'Nothing' if the trees contain different leaves. ----- XXX: Comparing a list of trees may recompute bipartitions.+-- XXX: Comparing a list of trees recomputes bipartitions. 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."@@ -99,7 +97,7 @@ -- A bipartition is incompatible with a tree if it is incompatible with all -- induced multifurcations of the tree. ----- XXX: Comparing a list of trees with this function recomputes bipartitions.+-- XXX: Comparing a list of trees recomputes bipartitions. incompatibleSplits :: (Show a, Ord a) => Tree e1 a -> Tree e2 a -> Either String Int incompatibleSplits t1 t2   | S.fromList (leaves t1) /= S.fromList (leaves t2) =@@ -125,7 +123,7 @@ -- Although a rooted tree data type is used, the distance between the unrooted -- trees is returned. ----- XXX: Comparing a list of trees with this function recomputes bipartitions.+-- XXX: Comparing a list of trees recomputes bipartitions. branchScore :: (Measurable e1, Measurable e2, Ord a) => Tree e1 a -> Tree e2 a -> Either String Double branchScore t1 t2   | S.fromList (leaves t1) /= S.fromList (leaves t2) = Left "branchScoreWith: Trees do not have equal leaf sets."@@ -134,4 +132,4 @@     bpToBr2 <- bipartitionToBranch $ first (Sum . getLen) t2     let dBs = M.unionWith (-) bpToBr1 bpToBr2         dsSquared = foldl' (\acc e -> acc + e * e) 0 dBs-    return $ sqrt $ getSum dsSquared+    return $ sqrt $ fromLength $ getSum dsSquared

@@ -23,15 +23,17 @@ import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy.Char8 as BL import Data.List (intersperse)+import ELynx.Tree.Measurable import ELynx.Tree.Named import ELynx.Tree.Phylogeny import ELynx.Tree.Rooted+import ELynx.Tree.Supported -buildBrSup :: Double -> BB.Builder-buildBrSup bs = BB.char8 '[' <> BB.doubleDec bs <> BB.char8 ']'+buildBrLen :: Length -> BB.Builder+buildBrLen bl = BB.char8 ':' <> BB.doubleDec (fromLength bl) -buildBrLen :: Double -> BB.Builder-buildBrLen bl = BB.char8 ':' <> BB.doubleDec bl+buildBrSup :: Support -> BB.Builder+buildBrSup bs = BB.char8 '[' <> BB.doubleDec (fromSupport bs) <> BB.char8 ']'  -- | See 'toNewick'. toNewickBuilder :: Named a => Tree Phylo a -> BB.Builder@@ -46,14 +48,22 @@     mBrSupBuilder x = maybe mempty buildBrSup (brSup x)     mBrLenBuilder x = maybe mempty buildBrLen (brLen x)     lbl x y =-      BB.lazyByteString (getName y)+      BB.lazyByteString (fromName $ getName y)         <> mBrLenBuilder x-        -- After reading several discussion, I go for the "more semantical+        -- After reading several discussions, I go for the "more semantical         -- form" with branch support values in square brackets.         <> mBrSupBuilder x  -- | General conversion of a tree into a Newick 'BL.Bytestring'. Use provided -- functions to extract node labels and branch lengths builder objects. See also -- Biobase.Newick.Export.+--+-- Functions to write key value pairs for nodes are not provided. Those can just+-- be set as node names. For example, the posterior density and the confidence+-- interval of a node can be encoded by setting the node name to:+--+-- @+-- "ACTUALNAME[posterior=-2839.2,age_95%_HPD={4.80804,31.6041}]"+-- @ toNewick :: Named a => Tree Phylo a -> BL.ByteString toNewick = BB.toLazyByteString . toNewickBuilder

@@ -45,7 +45,9 @@ import Data.Aeson (FromJSON, ToJSON) import Data.Attoparsec.ByteString.Char8 import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BL import ELynx.Tree.Measurable+import ELynx.Tree.Named import ELynx.Tree.Phylogeny import ELynx.Tree.Rooted hiding (forest, label) import ELynx.Tree.Supported@@ -75,51 +77,51 @@   "RevBayes: Key-value pairs is provided in square brackets after node names as well as branch lengths. XXX: Key value pairs are ignored at the moment."  -- | Newick tree parser. Also succeeds when more trees follow.-newick :: NewickFormat -> Parser (Tree Phylo BS.ByteString)+newick :: NewickFormat -> Parser (Tree Phylo Name) newick Standard = newickStandard newick IqTree = newickIqTree newick RevBayes = newickRevBayes  -- | See 'newick'.-parseNewick :: NewickFormat -> BS.ByteString -> Tree Phylo BS.ByteString+parseNewick :: NewickFormat -> BS.ByteString -> Tree Phylo Name parseNewick f = either error id . parseOnly (newick f)  -- | One Newick tree parser. Fails when end of input is not reached.-oneNewick :: NewickFormat -> Parser (Tree Phylo BS.ByteString)+oneNewick :: NewickFormat -> Parser (Tree Phylo Name) oneNewick Standard = oneNewickStandard oneNewick IqTree = oneNewickIqTree oneNewick RevBayes = oneNewickRevBayes  -- | See 'oneNewick'.-parseOneNewick :: NewickFormat -> BS.ByteString -> Tree Phylo BS.ByteString+parseOneNewick :: NewickFormat -> BS.ByteString -> Tree Phylo Name parseOneNewick f = either error id . parseOnly (oneNewick f)  -- | One or more Newick trees parser.-someNewick :: NewickFormat -> Parser (Forest Phylo BS.ByteString)+someNewick :: NewickFormat -> Parser (Forest Phylo Name) someNewick Standard = someNewickStandard someNewick IqTree = someNewickIqTree someNewick RevBayes = someNewickRevBayes  -- | See 'someNewick'.-parseSomeNewick :: NewickFormat -> BS.ByteString -> [Tree Phylo BS.ByteString]+parseSomeNewick :: NewickFormat -> BS.ByteString -> [Tree Phylo Name] parseSomeNewick f = either error id . parseOnly (someNewick f)  -- Parse a single Newick tree. Also succeeds when more trees follow.-newickStandard :: Parser (Tree Phylo BS.ByteString)+newickStandard :: Parser (Tree Phylo Name) newickStandard = skipWhile isSpace *> tree <* char ';' <* skipWhile isSpace <?> "newickStandard"  -- Parse a single Newick tree. Fails when end of file is not reached.-oneNewickStandard :: Parser (Tree Phylo BS.ByteString)+oneNewickStandard :: Parser (Tree Phylo Name) oneNewickStandard = newickStandard <* endOfInput <?> "oneNewickStandard"  -- Parse one ore more Newick trees until end of file.-someNewickStandard :: Parser (Forest Phylo BS.ByteString)+someNewickStandard :: Parser (Forest Phylo Name) someNewickStandard = some newickStandard <* endOfInput <?> "someNewickStandard" -tree :: Parser (Tree Phylo BS.ByteString)+tree :: Parser (Tree Phylo Name) tree = branched <|> leaf <?> "tree" -branched :: Parser (Tree Phylo BS.ByteString)+branched :: Parser (Tree Phylo Name) branched = (<?> "branched") $ do   f <- forest   n <- name@@ -127,11 +129,11 @@   return $ Node p n f  -- A 'forest' is a set of trees separated by @,@ and enclosed by parentheses.-forest :: Parser (Forest Phylo BS.ByteString)+forest :: Parser (Forest Phylo Name) forest = char '(' *> (tree `sepBy1` char ',') <* char ')' <?> "forest"  -- A 'leaf' has a 'name' and a 'phylo' branch.-leaf :: Parser (Tree Phylo BS.ByteString)+leaf :: Parser (Tree Phylo Name) leaf = (<?> "leaf") $ do   n <- name   p <- phylo@@ -142,56 +144,60 @@  -- A name can be any string of printable characters except blanks, colons, -- semicolons, parentheses, and square brackets (and commas).-name :: Parser BS.ByteString-name = takeWhile nameChar <?> "name"+name :: Parser Name+name = Name . BL.fromStrict <$> takeWhile nameChar <?> "name"  phylo :: Parser Phylo phylo = Phylo <$> optional branchLength <*> optional branchSupport <?> "phylo"  -- Branch length.-branchLength :: Parser BranchLength-branchLength = char ':' *> double <?> "branchLength"+branchLength :: Parser Length+branchLength = do+  _ <- char ':' <?> "branchLengthDelimiter"+  l <- double <?> "branchLength"+  return $ either error id $ toLength l -branchSupport :: Parser BranchSupport-branchSupport = (<?> "branchSupport") $+branchSupport :: Parser Support+branchSupport =   do-    _ <- char '['-    s <- double-    _ <- char ']'-    return s+    _ <- char '[' <?> "branchSupportBegin"+    s <- double <?> "branchSupport"+    _ <- char ']' <?> "branchSupportEnd"+    return $ either error id $ toSupport s  -------------------------------------------------------------------------------- -- IQ-TREE.  -- IQ-TREE stores the branch support as node names after the closing bracket of -- a forest. Parse a single Newick tree. Also succeeds when more trees follow.-newickIqTree :: Parser (Tree Phylo BS.ByteString)+newickIqTree :: Parser (Tree Phylo Name) newickIqTree = skipWhile isSpace *> treeIqTree <* char ';' <* skipWhile isSpace <?> "newickIqTree"  -- See 'newickIqTree'. Parse a single Newick tree. Fails when end of file is not -- reached.-oneNewickIqTree :: Parser (Tree Phylo BS.ByteString)+oneNewickIqTree :: Parser (Tree Phylo Name) oneNewickIqTree = newickIqTree <* endOfInput <?> "oneNewickIqTree"  -- See 'newickIqTree'. Parse one ore more Newick trees until end of file.-someNewickIqTree :: Parser (Forest Phylo BS.ByteString)+someNewickIqTree :: Parser (Forest Phylo Name) someNewickIqTree = some newickIqTree <* endOfInput <?> "someNewickIqTree"  -- IQ-TREE stores the branch support as node names after the closing bracket of a forest.-treeIqTree :: Parser (Tree Phylo BS.ByteString)+treeIqTree :: Parser (Tree Phylo Name) treeIqTree = branchedIqTree <|> leaf <?> "treeIqTree"  -- IQ-TREE stores the branch support as node names after the closing bracket of a forest.-branchedIqTree :: Parser (Tree Phylo BS.ByteString)+branchedIqTree :: Parser (Tree Phylo Name) branchedIqTree = (<?> "branchedIqTree") $ do   f <- forestIqTree-  s <- optional double+  ms <- optional double+  let s = either error id . toSupport <$> ms   n <- name   b <- optional branchLength   return $ Node (Phylo b s) n f  -- IQ-TREE stores the branch support as node names after the closing bracket of a forest.-forestIqTree :: Parser (Forest Phylo BS.ByteString)+forestIqTree :: Parser (Forest Phylo Name) forestIqTree = (<?> "forestIqTree") $ do   _ <- char '('   f <- treeIqTree `sepBy1` char ','@@ -206,7 +212,7 @@ -- trees follow. -- -- TODO: Key value pairs are ignored at the moment.-newickRevBayes :: Parser (Tree Phylo BS.ByteString)+newickRevBayes :: Parser (Tree Phylo Name) newickRevBayes =   skipWhile isSpace     *> optional brackets@@ -216,37 +222,37 @@  -- See 'newickRevBayes'. Parse a single Newick tree. Fails when end of file is -- not reached.-oneNewickRevBayes :: Parser (Tree Phylo BS.ByteString)+oneNewickRevBayes :: Parser (Tree Phylo Name) oneNewickRevBayes = newickRevBayes <* endOfInput <?> "oneNewickRevBayes"  -- See 'newickRevBayes'. Parse one ore more Newick trees until end of file.-someNewickRevBayes :: Parser (Forest Phylo BS.ByteString)+someNewickRevBayes :: Parser (Forest Phylo Name) someNewickRevBayes = some newickRevBayes <* endOfInput <?> "someNewickRevBayes" -treeRevBayes :: Parser (Tree Phylo BS.ByteString)+treeRevBayes :: Parser (Tree Phylo Name) treeRevBayes = branchedRevBayes <|> leafRevBayes <?> "treeRevBayes" -branchedRevBayes :: Parser (Tree Phylo BS.ByteString)+branchedRevBayes :: Parser (Tree Phylo Name) branchedRevBayes = (<?> "branchedRevgBayes") $ do   f <- forestRevBayes   n <- nameRevBayes   b <- optional branchLengthRevBayes   return $ Node (Phylo b Nothing) n f -forestRevBayes :: Parser (Forest Phylo BS.ByteString)+forestRevBayes :: Parser (Forest Phylo Name) forestRevBayes = (<?> "forestRevBayes") $ do   _ <- char '('   f <- treeRevBayes `sepBy1` char ','   _ <- char ')'   return f -nameRevBayes :: Parser BS.ByteString+nameRevBayes :: Parser Name nameRevBayes = name <* optional brackets <?> "nameRevBayes" -branchLengthRevBayes :: Parser BranchLength+branchLengthRevBayes :: Parser Length branchLengthRevBayes = branchLength <* optional brackets <?> "branchLengthRevBayes" -leafRevBayes :: Parser (Tree Phylo BS.ByteString)+leafRevBayes :: Parser (Tree Phylo Name) leafRevBayes = (<?> "leafRevBayes") $ do   n <- nameRevBayes   b <- optional branchLengthRevBayes

@@ -21,18 +21,19 @@ import qualified Data.ByteString.Char8 as BS import ELynx.Import.Nexus import ELynx.Tree.Import.Newick+import ELynx.Tree.Named import ELynx.Tree.Phylogeny import ELynx.Tree.Rooted import Prelude hiding (takeWhile)  -- | Parse a Nexus files with a TREES block.-nexusTrees :: NewickFormat -> Parser [(BS.ByteString, Tree Phylo BS.ByteString)]+nexusTrees :: NewickFormat -> Parser [(BS.ByteString, Tree Phylo Name)] nexusTrees = nexusBlock . trees -trees :: NewickFormat -> Block [(BS.ByteString, Tree Phylo BS.ByteString)]+trees :: NewickFormat -> Block [(BS.ByteString, Tree Phylo Name)] trees f = Block "TREES" (some $ namedNewick f) -namedNewick :: NewickFormat -> Parser (BS.ByteString, Tree Phylo BS.ByteString)+namedNewick :: NewickFormat -> Parser (BS.ByteString, Tree Phylo Name) namedNewick f = do   _ <- skipWhile isSpace   _ <- stringCI "TREE" <?> "namedNewickTreeStart"

@@ -1,6 +1,10 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+ -- | -- Module      :  ELynx.Tree.Measurable--- Description :  Measurable branch labels+-- Description :  Measurable labels -- Copyright   :  (c) Dominik Schrempf 2020 -- License     :  GPL-3.0-or-later --@@ -10,17 +14,19 @@ -- -- Creation date: Thu Jan 17 14:16:34 2019. ----- Non-negativity of branch lengths is not (yet) ensured. To ensure--- non-negativity, a newtype wrapper could be used, but this would be a major--- refactor.+-- Non-negativity of lengths is not completely ensured. See the documentation of+-- 'Length'. module ELynx.Tree.Measurable-  ( BranchLength,+  ( -- * Non-negative length+    Length (fromLength),+    toLength,+    toLengthUnsafe,+    checkLength,     Measurable (..),-    applyStem,-    getStem,-    setStem,     height,     rootHeight,++    -- * Functions on trees     distancesOriginLeaves,     totalBranchLength,     normalizeBranchLengths,@@ -30,83 +36,126 @@   ) where +import Control.DeepSeq+import Data.Aeson import Data.Bifoldable import Data.Bifunctor+import Data.Semigroup import ELynx.Tree.Rooted+import ELynx.Tree.Splittable+import GHC.Generics --- | Branch length.-type BranchLength = Double+-- | Non-negative length.+--+-- However, non-negativity is only checked with 'toLength', and negative values+-- can be obtained using the 'Num' and related instances.+--+-- Safe operations with conversion from and to length are roughly 50 percent+-- slower.+--+-- @+-- benchmarking length/length sum foldl' with safe conversion+-- time                 110.4 ms   (109.8 ms .. 111.0 ms)+--                      1.000 R²   (1.000 R² .. 1.000 R²)+-- mean                 110.2 ms   (110.0 ms .. 110.6 ms)+-- std dev              501.8 μs   (359.1 μs .. 730.0 μs)+--+-- benchmarking length/length sum foldl' num instance+-- time                 89.37 ms   (85.13 ms .. 94.27 ms)+--                      0.996 R²   (0.992 R² .. 1.000 R²)+-- mean                 86.53 ms   (85.63 ms .. 88.52 ms)+-- std dev              2.239 ms   (1.069 ms .. 3.421 ms)+--+-- benchmarking length/double sum foldl'+-- time                 85.47 ms   (84.88 ms .. 86.42 ms)+--                      1.000 R²   (0.999 R² .. 1.000 R²)+-- mean                 85.56 ms   (85.26 ms .. 86.02 ms)+-- std dev              611.9 μs   (101.5 μs .. 851.7 μs)+-- @+newtype Length = Length {fromLength :: Double}+  deriving (Read, Show, Generic, NFData)+  deriving (Enum, Eq, Floating, Fractional, Num, Ord, Real, RealFloat, RealFrac) via Double+  deriving (Semigroup, Monoid) via Sum Double --- | A branch label with measurable and modifiable branch length.-class Measurable e where-  -- | Length of attached branch.-  getLen :: e -> BranchLength+instance Splittable Length where+  split = (/ 2.0) -  -- | Set attached branch length.-  setLen :: BranchLength -> e -> e+instance ToJSON Length -instance Measurable Double where+instance FromJSON Length++instance Measurable Length where   getLen = id   setLen = const+  modLen f = f --- Apply a function to a branch support label.-apply :: Measurable e => (BranchLength -> BranchLength) -> e -> e-apply f l = setLen (f s) l where s = getLen l+-- | 'Nothing' if length is negative.+toLength :: Double -> Either String Length+toLength x+  | x < 0 = Left $ "length: Length is negative: " ++ show x ++ "."+  | otherwise = Right $ Length x --- | Lengthen the stem of a tree.-applyStem :: Measurable e => (BranchLength -> BranchLength) -> Tree e a -> Tree e a-applyStem f t = t {branch = apply f b}-  where-    b = branch t+-- | Do not check if support value is negative.+toLengthUnsafe :: Double -> Length+toLengthUnsafe = Length --- | Get the length of the stem of a tree.-getStem :: Measurable e => Tree e a -> BranchLength-getStem (Node br _ _) = getLen br+-- | 'Nothing' if length is negative.+checkLength :: Length -> Either String Length+checkLength = toLength . fromLength --- | Set the length of the stem of a tree.-setStem :: Measurable e => BranchLength -> Tree e a -> Tree e a-setStem x = applyStem (const x)+-- | A data type with measurable and modifiable length.+class Measurable e where+  -- | Get length.+  getLen :: e -> Length +  -- | Set length.+  setLen :: Length -> e -> e++  -- For computational efficiency.++  -- | Modify length.+  modLen :: (Length -> Length) -> e -> e+ -- | The maximum distance between origin and leaves. ----- The height includes the length of the stem.-height :: Measurable e => Tree e a -> BranchLength+-- The height includes the branch length of the stem.+height :: Measurable e => Tree e a -> Length height = maximum . distancesOriginLeaves  -- | The maximum distance between root node and leaves.-rootHeight :: Measurable e => Tree e a -> BranchLength+rootHeight :: Measurable 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 length of the stem.-distancesOriginLeaves :: Measurable e => Tree e a -> [BranchLength]+-- The distances include the branch length of the stem.+distancesOriginLeaves :: Measurable e => Tree e a -> [Length] distancesOriginLeaves (Node br _ []) = [getLen br] distancesOriginLeaves (Node br _ ts) = map (getLen br +) (concatMap distancesOriginLeaves ts)  -- | Total branch length of a tree.-totalBranchLength :: Measurable e => Tree e a -> BranchLength+totalBranchLength :: Measurable e => Tree e a -> Length totalBranchLength = bifoldl' (+) const 0 . first getLen  -- | Normalize branch lengths so that the sum is 1.0. normalizeBranchLengths :: Measurable e => Tree e a -> Tree e a-normalizeBranchLengths t = first (apply (/ s)) t+normalizeBranchLengths t = first (modLen (/ s)) t   where     s = totalBranchLength t  -- | Normalize height of tree to 1.0. normalizeHeight :: Measurable e => Tree e a -> Tree e a-normalizeHeight t = first (apply (/ h)) t+normalizeHeight t = first (modLen (/ h)) t   where     h = height t  eps :: Double eps = 1e-12 -allNearlyEqual :: [Double] -> Bool+allNearlyEqual :: [Length] -> Bool allNearlyEqual [] = True-allNearlyEqual xs = all (\y -> eps > abs (x - y)) (tail xs)+allNearlyEqual xs = all (\y -> eps > abs (fromLength $ x - y)) (tail xs)   where     x = head xs @@ -119,6 +168,6 @@ makeUltrametric t = go 0 t   where     h = height t-    go :: Measurable e => BranchLength -> Tree e a -> Tree e a-    go h' (Node br lb []) = let dh = h - h' - getLen br in Node (apply (+ dh) br) lb []+    go :: Measurable e => Length -> Tree e a -> Tree e a+    go h' (Node br lb []) = let dh = h - h' - getLen br in Node (modLen (+ dh) br) lb []     go h' (Node br lb ts) = let h'' = h' + getLen br in Node br lb $ map (go h'') ts

@@ -1,3 +1,6 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE TypeSynonymInstances #-}+ -- | -- Module      :  ELynx.Tree.Named -- Description :  Trees with named nodes@@ -10,34 +13,60 @@ -- -- Creation date: Thu Jan 24 20:09:20 2019. module ELynx.Tree.Named-  ( Named (..),+  ( Name (..),+    Named (..),   ) where +import Control.DeepSeq+import Data.Aeson import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BL import Data.Double.Conversion.ByteString as BC+import Data.String +-- | Node name.+--+-- Use lazy byte strings because Newick strings are built using chunks.+newtype Name = Name {fromName :: BL.ByteString}+  deriving (Show, Eq)+  deriving (Ord, Monoid, Semigroup, IsString, NFData) via BL.ByteString++-- XXX: This is pretty lame, but I need those instances. At the moment, I just+-- go via 'String', but this is certainly not the best solution.++instance ToJSON Name where+  toJSON = toJSON . BL.unpack . fromName+  toEncoding = toEncoding . BL.unpack . fromName++instance FromJSON Name where+  parseJSON = fmap (Name . BL.pack) . parseJSON++instance Named Name where+  getName = id+ -- | Data types with names. class Named a where-  -- Use lazy byte strings because Newick strings are built using chunks.-  getName :: a -> BL.ByteString+  getName :: a -> Name  instance Named () where-  getName = const BL.empty+  getName = const (Name BL.empty)  instance Named Int where-  getName = BB.toLazyByteString . BB.intDec+  getName = Name . BB.toLazyByteString . BB.intDec  instance Named Double where-  getName = BL.fromStrict . toShortest+  getName = Name . BL.fromStrict . toShortest  instance Named Char where-  getName = BB.toLazyByteString . BB.char8+  getName = Name . BB.toLazyByteString . BB.char8 +instance (Named a) => Named [a] where+  getName = Name . BL.concat . map (fromName . getName)+ instance Named BL.ByteString where-  getName = id+  getName = Name  instance Named BS.ByteString where-  getName = BL.fromStrict+  getName = Name . BL.fromStrict

@@ -14,18 +14,27 @@ -- -- Creation date: Thu Jan 17 16:08:54 2019. ----- A phylogeny is a 'Tree' with unique leaf labels, and the order of the trees--- in the sub-forest is considered to be meaningless.+-- The purpose of this module is to facilitate usage of 'Tree's in phylogenetic+-- analyses. A /phylogeny/ is a 'Tree' with unique leaf labels, and unordered+-- sub-forest. ----- Internally, however, the underlying 'Tree' data structure stores the--- sub-forest as a list, which has a specific order. Hence, we have to do some--- tricks when comparing trees, and tree comparison is slow.+-- Using the 'Tree' data type has some disadvantages. ----- Also, the uniqueness of the leaves is not ensured by the data type, but has--- to be checked at runtime. Functions relying on the tree to have unique leaves--- do perform this check, and return 'Left' with an error message, if the tree--- has duplicate leaves.+-- 1. All trees are rooted. Unrooted trees can be treated with a rooted data+-- structure, as it is used here. However, some functions may be meaningless. --+-- 2. Changing branch labels, node labels, or the topology of the tree are slow+-- operations, especially, when the changes are close to the leaves of the tree.+--+-- 3. Internally, the underlying 'Tree' data structure stores the sub-forest as+-- an ordered list. Hence, we have to do some tricks when comparing phylogenies+-- (see 'equal'), and comparison is slow.+--+-- 4. Uniqueness of the leaves is not ensured by the data type, but has to be+-- checked at runtime. Functions relying on the tree to have unique leaves do+-- perform this check, and return 'Left' with an error message, if the tree has+-- duplicate leaves.+-- -- Note: 'Tree's are rooted. -- -- Note: 'Tree's encoded in Newick format correspond to rooted trees. By@@ -34,10 +43,10 @@ -- convention is not used here. Newick trees are just parsed as they are, and a -- rooted tree is returned. ----- The bifurcating root of a tree can be changed with 'rootAt' or 'midpoint'; a--- list of all rooted trees is returned by 'roots'.--- -- Trees with multifurcating root nodes can be rooted using 'outgroup'.+--+-- Trees with bifurcating root nodes can be changed with 'rootAt' or 'midpoint';+-- a list of all rooted trees is returned by 'roots'. module ELynx.Tree.Phylogeny   ( -- * Functions     equal,@@ -53,9 +62,7 @@     toPhyloTree,     measurableToPhyloTree,     supportedToPhyloTree,-    Length (..),     phyloToLengthTree,-    Support (..),     phyloToSupportTree,     phyloToSupportTreeUnsafe,     PhyloExplicit (..),@@ -81,6 +88,8 @@ import ELynx.Tree.Supported import GHC.Generics +-- A faster check could probably be done using 'Ord' and sets. The leave set+-- could be precomputed. -- | The equality check is slow because the order of children is considered to -- be arbitrary. equal :: (Eq e, Eq a) => Tree e a -> Tree e a -> Bool@@ -149,8 +158,8 @@ -- If the root node is bifurcating, use 'rootAt'. -- -- Return 'Left' if--- - the tree has duplicate leaves; -- - the root node is not multifurcating;+-- - the tree has duplicate leaves; -- - the provided outgroup is not found on the tree or is polyphyletic. outgroup :: (Semigroup e, Splittable e, Ord a) => Set a -> a -> Tree e a -> Either String (Tree e a) outgroup _ _ (Node _ _ []) = Left "outgroup: Root node is a leaf."@@ -196,7 +205,12 @@     let hl = height l         hr = height r         dh = (hl - hr) / 2-     in Node br lb [applyStem (subtract dh) l, applyStem (+ dh) r]+     in Node+          br+          lb+          [ applyStem (modLen (subtract dh)) l,+            applyStem (modLen (+ dh)) r+          ]   -- Explicitly use 'error' here, because roots is supposed to return trees with   -- bifurcating root nodes.   _ -> error "getMidpoint: Root node is not bifurcating."@@ -208,7 +222,7 @@ -- find index of minimum; take this tree and move root to the midpoint of the branch  -- Get delta height of left and right sub tree.-getDeltaHeight :: Measurable e => Tree e a -> Double+getDeltaHeight :: Measurable e => Tree e a -> Length getDeltaHeight (Node _ _ [l, r]) = abs $ height l - height r -- Explicitly use 'error' here, because roots is supposed to return trees with -- bifurcating root nodes.@@ -217,7 +231,7 @@ -- | For a rooted tree with a bifurcating root node, get all possible rooted -- trees. ----- The root node is moved.+-- The root node (label and branch) is moved. -- -- For a tree with @l=2@ leaves, there is one rooted tree. For a bifurcating -- tree with @l>2@ leaves, there are @(2l-3)@ rooted trees. For a general tree@@ -312,8 +326,8 @@ -- -- Branches may have a length and a support value. data Phylo = Phylo-  { brLen :: Maybe BranchLength,-    brSup :: Maybe BranchSupport+  { brLen :: Maybe Length,+    brSup :: Maybe Support   }   deriving (Read, Show, Eq, Ord, Generic, NFData) @@ -327,7 +341,7 @@  instance FromJSON Phylo --- | Set all branch length and support values to 'Just' the value.+-- | Set all branch lengths and support values to 'Just' the value. -- -- Useful to export a tree with branch lengths in Newick format. toPhyloTree :: (Measurable e, Supported e) => Tree e a -> Tree Phylo a@@ -336,77 +350,40 @@ toPhyloLabel :: (Measurable e, Supported e) => e -> Phylo toPhyloLabel x = Phylo (Just $ getLen x) (Just $ getSup x) --- | Set all branch support values to 'Nothing'.+-- | Set all branch lengths to 'Just' the values, and all support values to+-- 'Nothing'. ----- Useful to export a tree with branch lengths to Newick format.+-- Useful to export a tree with branch lengths but without branch support values+-- to Newick format. measurableToPhyloTree :: Measurable e => Tree e a -> Tree Phylo a measurableToPhyloTree = first measurableToPhyloLabel  measurableToPhyloLabel :: Measurable e => e -> Phylo measurableToPhyloLabel x = Phylo (Just $ getLen x) Nothing --- | Set all branch lengths to 'Nothing'.+-- | Set all branch lengths to 'Nothing', and all support values to 'Just' the+-- values. ----- Useful to export a tree with branch support to Newick format.+-- Useful to export a tree with branch support values but without branch lengths+-- to Newick format. supportedToPhyloTree :: Supported e => Tree e a -> Tree Phylo a supportedToPhyloTree = first supportedToPhyloLabel  supportedToPhyloLabel :: Supported e => e -> Phylo supportedToPhyloLabel x = Phylo Nothing (Just $ getSup x) --- | Branch length label.------ For conversion, see 'phyloToLengthTree'.-newtype Length = Length {fromLength :: BranchLength}-  deriving (Read, Show, Eq, Ord, Generic, NFData)-  deriving (Num, Fractional, Floating) via Double-  deriving (Semigroup, Monoid) via Sum Double--instance Measurable Length where-  getLen = fromLength-  setLen b _ = Length b--instance Splittable Length where-  split = Length . (/ 2.0) . fromLength--instance ToJSON Length--instance FromJSON Length- -- | If root branch length is not available, set it to 0. -- -- Return 'Left' if any other branch length is unavailable. phyloToLengthTree :: Tree Phylo a -> Either String (Tree Length a) phyloToLengthTree =   maybe (Left "phyloToLengthTree: Length unavailable for some branches.") Right-    . bitraverse toLength pure-    . cleanRootLength--cleanRootLength :: Tree Phylo a -> Tree Phylo a-cleanRootLength (Node (Phylo Nothing s) l f) = Node (Phylo (Just 0) s) l f-cleanRootLength t = t--toLength :: Phylo -> Maybe Length-toLength p = Length <$> brLen p---- | Branch support label.------ For conversion, see 'phyloToSupportTree'.-newtype Support = Support {fromSupport :: BranchSupport}-  deriving (Read, Show, Eq, Ord, Generic, NFData)-  deriving (Num, Fractional, Floating) via Double-  deriving (Semigroup) via Min Double--instance Supported Support where-  getSup = fromSupport-  setSup s _ = Support s--instance Splittable Support where-  split = id--instance ToJSON Support+    . bitraverse brLen pure+    . cleanStemLength -instance FromJSON Support+cleanStemLength :: Tree Phylo a -> Tree Phylo a+cleanStemLength (Node (Phylo Nothing s) l f) = Node (Phylo (Just 0) s) l f+cleanStemLength t = t  -- | Set branch support values of branches leading to the leaves and of the root -- branch to maximum support.@@ -415,9 +392,9 @@ phyloToSupportTree :: Tree Phylo a -> Either String (Tree Support a) phyloToSupportTree t =   maybe-    (Left "phyloToSupportTree: Support unavailable for some branches.")+    (Left "phyloToSupportTree: Support value unavailable for some branches.")     Right-    $ bitraverse toSupport pure $+    $ bitraverse brSup pure $       cleanLeafSupport m $         cleanRootSupport m t   where@@ -430,28 +407,24 @@     m = getMaxSupport t  -- If all branch support values are below 1.0, set the max support to 1.0.-getMaxSupport :: Tree Phylo a -> BranchSupport+getMaxSupport :: Tree Phylo a -> Support getMaxSupport = fromJust . max (Just 1.0) . bimaximum . bimap brSup (const Nothing) -cleanRootSupport :: BranchSupport -> Tree Phylo a -> Tree Phylo a+cleanRootSupport :: Support -> Tree Phylo a -> Tree Phylo a cleanRootSupport maxSup (Node (Phylo b Nothing) l xs) = Node (Phylo b (Just maxSup)) l xs cleanRootSupport _ t = t -cleanLeafSupport :: BranchSupport -> Tree Phylo a -> Tree Phylo a+cleanLeafSupport :: Support -> Tree Phylo a -> Tree Phylo a cleanLeafSupport s (Node (Phylo b Nothing) l []) = Node (Phylo b (Just s)) l [] cleanLeafSupport s (Node b l xs) = Node b l $ map (cleanLeafSupport s) xs -toSupport :: Phylo -> Maybe Support-toSupport (Phylo _ Nothing) = Nothing-toSupport (Phylo _ (Just s)) = Just $ Support s--cleanSupport :: BranchSupport -> Tree Phylo a -> Tree Support a-cleanSupport maxSup (Node (Phylo _ s) l xs) = Node (Support $ fromMaybe maxSup s) l $ map (cleanSupport maxSup) xs+cleanSupport :: Support -> Tree Phylo a -> Tree Support a+cleanSupport maxSup (Node (Phylo _ s) l xs) = Node (fromMaybe maxSup s) l $ map (cleanSupport maxSup) xs --- | Explicit branch label for phylogenetic trees.+-- | Explicit branch label with branch length and branch support value. data PhyloExplicit = PhyloExplicit-  { sBrLen :: BranchLength,-    sBrSup :: BranchSupport+  { sBrLen :: Length,+    sBrSup :: Support   }   deriving (Read, Show, Eq, Ord, Generic) @@ -460,7 +433,8 @@  instance Measurable PhyloExplicit where   getLen = sBrLen-  setLen b l = l {sBrLen = b}+  setLen b pl = pl {sBrLen = b}+  modLen f (PhyloExplicit l s) = PhyloExplicit (f l) s  instance Splittable PhyloExplicit where   split l = l {sBrLen = b'}@@ -469,7 +443,8 @@  instance Supported PhyloExplicit where   getSup = sBrSup-  setSup s l = l {sBrSup = s}+  setSup s pl = pl {sBrSup = s}+  modSup f (PhyloExplicit l s) = PhyloExplicit l (f s)  instance ToJSON PhyloExplicit @@ -480,8 +455,9 @@ -- See 'phyloToLengthTree' and 'phyloToSupportTree'. toExplicitTree :: Tree Phylo a -> Either String (Tree PhyloExplicit a) toExplicitTree t = do-  lt <- first fromLength <$> phyloToLengthTree t-  st <- first fromSupport <$> phyloToSupportTree t+  lt <- phyloToLengthTree t+  st <- phyloToSupportTree t   case zipTreesWith PhyloExplicit const lt st of-    Nothing -> error "toExplicitTree: This is a bug. Can not zip two trees with the same topology."+    -- Explicit use of error, since this case should not happen.+    Nothing -> error "toExplicitTree: Can not zip two trees with the same topology."     Just zt -> return zt

@@ -39,18 +39,8 @@ -- The value constructor /Node/ and the record function /label/ are not to be -- confused. The elements of the sub-forest are often called /children/. ----- With respect to phylogenetic analyses, using the 'Tree' data type has some--- disadvantages:------ 1. All trees are rooted. Unrooted trees can be treated with a rooted data--- structure, as it is used here. However, some functions may be meaningless.------ 2. Changing branch labels, node labels, or the topology of the tree are slow--- operations, especially, when the changes are close to the leaves of the tree.--- -- In mathematical terms: A 'Tree' is a directed acyclic graph without loops,--- with vertex labels, with edge labels. Let me know if this definition is--- incomplete.+-- with vertex labels, and with edge labels. module ELynx.Tree.Rooted   ( -- * Data type     Tree (..),@@ -61,13 +51,18 @@     -- * Access leaves, branches and labels     leaves,     duplicateLeaves,+    setStem,+    applyStem,     branches,     setBranches,+    setLabel,+    applyLabel,     labels,     setLabels,+    applyRoot,     identify, -    -- * Change structure+    -- * Structure     degree,     prune,     dropNodesWith,@@ -245,6 +240,14 @@ duplicateLeaves :: Ord a => Tree e a -> Bool duplicateLeaves = duplicates . leaves +-- | Set the stem to a given value.+setStem :: e -> Tree e a -> Tree e a+setStem br (Node _ lb ts) = Node br lb ts++-- | Change the root branch of a tree.+applyStem :: (e -> e) -> Tree e a -> Tree e a+applyStem f t = t {branch = f $ branch t}+ -- | Get branch labels in pre-order. branches :: Tree e a -> [e] branches t = squish t []@@ -261,6 +264,14 @@     setBranch (y : ys) _ = (ys, Just y)     noChange ys z = (ys, Just z) +-- | Set the label to a given value.+setLabel :: a -> Tree e a -> Tree e a+setLabel lb (Node br _ ts) = Node br lb ts++-- | Change the root branch of a tree.+applyLabel :: (a -> a) -> Tree e a -> Tree e a+applyLabel f t = t {label = f $ label t}+ -- | Return node labels in pre-order. labels :: Tree e a -> [a] labels t = squish t []@@ -271,10 +282,14 @@ -- -- Return 'Nothing' if the provided list of node labels is too short. setLabels :: Traversable t => [b] -> t a -> Maybe (t b)-setLabels xs = sequenceA . snd . mapAccumL setLabel xs+setLabels xs = sequenceA . snd . mapAccumL setLabelM xs   where-    setLabel [] _ = ([], Nothing)-    setLabel (y : ys) _ = (ys, Just y)+    setLabelM [] _ = ([], Nothing)+    setLabelM (y : ys) _ = (ys, Just y)++-- | Change the root label of a tree.+applyRoot :: (a -> a) -> Tree e a -> Tree e a+applyRoot f t = t {label = f $ label t}  -- | Label the nodes with unique integers starting at the root with 0. identify :: Traversable t => t a -> t Int

@@ -17,7 +17,6 @@ import Control.Monad.Primitive import ELynx.Tree.Distribution.CoalescentContinuous import ELynx.Tree.Measurable-import ELynx.Tree.Phylogeny import ELynx.Tree.Rooted import Statistics.Distribution import System.Random.MWC@@ -32,7 +31,7 @@   m (Tree Length Int) simulate n = simulate' n 0 trs   where-    trs = [Node (Length 0) i [] | i <- [0 .. n - 1]]+    trs = [Node 0 i [] | i <- [0 .. n - 1]]  simulate' ::   (PrimMonad m) =>@@ -49,12 +48,12 @@     -- Indices of the leaves to join will be i-1 and i.     i <- uniformR (1, n - 1) g     -- The time of the coalescent event.-    t <- genContVar (coalescentDistributionCont n) g+    t <- toLengthUnsafe <$> genContVar (coalescentDistributionCont n) g     let trs' = map (applyStem (+ t)) trs -- Move time 't' up on the tree.         tl = trs' !! (i - 1)         tr = trs' !! i         -- Join the two chosen trees.-        tm = Node (Length 0) a [tl, tr]+        tm = Node 0 a [tl, tr]         -- Take the trees on the left, the merged tree, and the trees on the right.         trs'' = take (i - 1) trs' ++ [tm] ++ drop (i + 1) trs'     simulate' (n - 1) a trs'' g

@@ -41,7 +41,6 @@ import ELynx.Tree.Distribution.TimeOfOriginNearCritical import ELynx.Tree.Distribution.Types import ELynx.Tree.Measurable-import ELynx.Tree.Phylogeny import ELynx.Tree.Rooted import qualified Statistics.Distribution as D   ( genContVar,@@ -263,8 +262,9 @@   -- | Generator (see 'System.Random.MWC')   Gen (PrimState m) ->   m (Tree Length Int)-simulateReconstructedTree n t l m g =-  toReconstructedTree 0 <$> simulate n t l m g+simulateReconstructedTree n t l m g = do+  PointProcess ns vs o <- simulate n t l m g+  return $ toReconstructedTree 0 $ PointProcess ns (map toLengthUnsafe vs) (toLengthUnsafe o)  -- | Convert a point process to a reconstructed tree. See Lemma 2.2. @@ -278,7 +278,7 @@ -- (useless) argument. toReconstructedTree ::   a -> -- Default node label.-  PointProcess a Double ->+  PointProcess a Length ->   Tree Length a toReconstructedTree l pp@(PointProcess ps vs o)   | length ps /= length vs + 1 = error "Too few or too many points."@@ -289,7 +289,7 @@     treeOrigin   where     (vsSorted, isSorted) = sortPP pp-    !lvs = S.fromList [Node (Length 0) p [] | p <- ps]+    !lvs = S.fromList [Node 0 p [] | p <- ps]     !heights = S.replicate (length ps) 0     !treeRoot = toReconstructedTree' isSorted vsSorted l lvs heights     !h = last vsSorted@@ -298,10 +298,10 @@ -- Move up the tree, connect nodes when they join according to the point process. toReconstructedTree' ::   [Int] -> -- Sorted indices, see 'sort'.-  [Double] -> -- Sorted merge values.+  [Length] -> -- Sorted merge values.   a -> -- Default node label.   Seq (Tree Length a) -> -- Leaves with accumulated root branch lengths.-  Seq Double -> -- Accumulated heights of the leaves.+  Seq Length -> -- Accumulated heights of the leaves.   Tree Length a toReconstructedTree' [] [] _ trs _ = trs `S.index` 0 toReconstructedTree' is vs l trs hs = toReconstructedTree' is' vs' l trs'' hs'@@ -320,6 +320,6 @@     !tl = applyStem (+ dvl) $ trs `S.index` i     !tr = applyStem (+ dvr) $ trs `S.index` (i + 1)     !h' = hl + dvl -- Should be the same as 'hr + dvr'.-    !tm = Node (Length 0) l [tl, tr]+    !tm = Node 0 l [tl, tr]     !trs'' = (S.take i trs S.|> tm) S.>< S.drop (i + 2) trs     !hs' = (S.take i hs S.|> h') S.>< S.drop (i + 2) hs

@@ -1,6 +1,10 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+ -- | -- Module      :  ELynx.Tree.Supported--- Description :  Branch label with support value+-- Description :  Labels with support values -- Copyright   :  (c) Dominik Schrempf 2020 -- License     :  GPL-3.0-or-later --@@ -9,57 +13,93 @@ -- Portability :  portable -- -- Creation date: Thu Jun 13 14:06:45 2019.------ Non-negativity of branch support values is not (yet) ensured. To ensure--- non-negativity, a newtype wrapper could be used, but this would be a major--- refactor. module ELynx.Tree.Supported-  ( BranchSupport,+  ( -- * Non-negative support value+    Support (fromSupport),+    toSupport,+    toSupportUnsafe,     Supported (..),++    -- * Functions on trees     normalizeBranchSupport,     collapse,   ) where +import Control.DeepSeq+import Data.Aeson import Data.Bifoldable import Data.Bifunctor import Data.List+import Data.Semigroup import ELynx.Tree.Rooted+import ELynx.Tree.Splittable+import GHC.Generics --- | Branch support.-type BranchSupport = Double+-- | Non-negative support value.+--+-- However, non-negativity is only checked with 'toSupport', and negative values+-- can be obtained using the 'Num' and related instances.+--+-- See also the documentation of 'ELynx.Tree.Measurable.Length'.+newtype Support = Support {fromSupport :: Double}+  deriving (Read, Show, Generic, NFData)+  deriving (Enum, Eq, Floating, Fractional, Num, Ord, Real, RealFloat, RealFrac) via Double+  deriving (Semigroup) via Min Double --- | A branch label that supports extraction and setting of branch support values.+instance Splittable Support where+  split = id++instance ToJSON Support++instance FromJSON Support++instance Supported Support where+  getSup = id+  setSup = const+  modSup f = f++-- | Nothing if support is negative.+toSupport :: Double -> Either String Support+toSupport x+  | x < 0 = Left $ "toSupport: Support is negative: " ++ show x ++ "."+  | otherwise = Right $ Support x++-- | Do not check if support value is negative.+toSupportUnsafe :: Double -> Support+toSupportUnsafe = Support++-- | A data type that supports extraction, setting and modifying of support+-- values. class Supported e where-  getSup :: e -> BranchSupport-  setSup :: BranchSupport -> e -> e+  getSup :: e -> Support+  setSup :: Support -> e -> e --- Apply a function to a branch support label.-apply :: Supported e => (BranchSupport -> BranchSupport) -> e -> e-apply f l = setSup (f s) l where s = getSup l+  -- For computational efficiency.+  modSup :: (Support -> Support) -> e -> e  -- | Normalize branch support values. The maximum branch support value will be -- set to 1.0. normalizeBranchSupport :: Supported e => Tree e a -> Tree e a-normalizeBranchSupport t = first (apply (/ m)) t+normalizeBranchSupport t = first (modSup (/ m)) t   where     m = bimaximum $ bimap getSup (const 0) t  -- | Collapse branches with support lower than given value. -- -- The branch and node labels of the collapsed branches are discarded.-collapse :: (Eq e, Eq a, Supported e) => BranchSupport -> Tree e a -> Tree e a+collapse :: (Eq e, Eq a, Supported e) => Support -> Tree e a -> Tree e a collapse th tr =   let tr' = collapse' th tr    in if tr == tr' then tr else collapse th tr'  -- A leaf has full support.-highP :: Supported e => Double -> Tree e a -> Bool+highP :: Supported e => Support -> Tree e a -> Bool highP _ (Node _ _ []) = True highP th (Node br _ _) = getSup br >= th  -- See 'collapse'.-collapse' :: Supported e => BranchSupport -> Tree e a -> Tree e a+collapse' :: Supported 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

@@ -23,8 +23,10 @@     goLeft,     goRight,     goChild,+    Path,     goPath,-    unsafeGoPath,+    goPathUnsafe,+    getSubTreeUnsafe,      -- * Modification     insertTree,@@ -120,17 +122,23 @@     where       (ls', rs') = splitAt n ts +-- | Path from the root of a tree to the node of the tree.+--+-- The position is specific to a tree topology. If the topology changes, the+-- position becomes invalid.+type Path = [Int]+ -- | Go to node with given path.-goPath :: [Int] -> TreePos e a -> Maybe (TreePos e a)+goPath :: Path -> TreePos e a -> Maybe (TreePos e a) goPath pos pth = foldlM (flip goChild) pth pos  -- | Go to child with given index in forest. Call 'error' if child does not -- exist.-unsafeGoChild :: Int -> TreePos e a -> TreePos e a-unsafeGoChild n pos = case current pos of+goChildUnsafe :: Int -> TreePos e a -> TreePos e a+goChildUnsafe n pos = case current pos of   (Node br lb ts)-    | null ts -> error "unsafeGoChild: Forest is empty."-    | length ts <= n -> error "unsafeGoChild: Forest is too short."+    | null ts -> error "goChildUnsafe: Forest is empty."+    | length ts <= n -> error "goChildUnsafe: Forest is too short."     | otherwise ->       Pos         { current = head rs',@@ -141,9 +149,17 @@     where       (ls', rs') = splitAt n ts --- | Got to node with given path. Call 'error' if path is invalid.-unsafeGoPath :: [Int] -> TreePos e a -> TreePos e a-unsafeGoPath pos pth = foldl (flip unsafeGoChild) pth pos+-- | Got to node with given path.+--+-- Call 'error' if path is invalid.+goPathUnsafe :: Path -> TreePos e a -> TreePos e a+goPathUnsafe pos pth = foldl (flip goChildUnsafe) pth pos++-- | Get the sub tree at path.+--+-- Call 'error' if path is invalid.+getSubTreeUnsafe :: Path -> Tree e a -> Tree e a+getSubTreeUnsafe p = current . goPathUnsafe p . fromTree  -- | Insert a new tree into the current focus of the zipper. insertTree :: Tree e a -> TreePos e a -> TreePos e a

@@ -26,7 +26,10 @@ -- XXX: This instance does not produce values without branch lengths nor branch -- supports. instance Arbitrary Phylo where-  arbitrary = Phylo <$> (Just <$> choose (1, 100)) <*> (Just <$> choose (0.001, 10))+  arbitrary =+    Phylo+      <$> (Just . toLengthUnsafe <$> choose (0.001 :: Double, 10))+      <*> (Just . toSupportUnsafe . fromIntegral <$> choose (1 :: Int, 100))  instance Arbitrary2 Tree where   liftArbitrary2 arbB arbN = go@@ -63,4 +66,4 @@     coarbitrary br . coarbitrary val . coarbitrary frst  instance Arbitrary Length where-  arbitrary = Length . getPositive <$> arbitrary+  arbitrary = toLengthUnsafe . getPositive <$> arbitrary

@@ -15,7 +15,6 @@   ) where -import qualified Data.ByteString.Char8 as BS import Data.Map (Map) import qualified Data.Map as M import Data.Set (Set)@@ -24,16 +23,16 @@ import ELynx.Tree import Test.Hspec -sfrom :: [BS.ByteString] -> S.Set BS.ByteString+sfrom :: [Name] -> S.Set Name sfrom = S.fromList  treeFileSimple :: FilePath treeFileSimple = "data/TreeDist.trees" -getSimpleTrees :: IO (Forest Phylo BS.ByteString)+getSimpleTrees :: IO (Forest Phylo Name) getSimpleTrees = parseFileWith (someNewick Standard) treeFileSimple -bipartitionToBranchAnswer :: Map (Bipartition BS.ByteString) Length+bipartitionToBranchAnswer :: Map (Bipartition Name) Length bipartitionToBranchAnswer =   M.fromList     [ (bpUnsafe (sfrom ["B"]) (sfrom ["A", "C", "D", "E"]), 0.3),@@ -45,7 +44,7 @@       (bpUnsafe (sfrom ["E"]) (sfrom ["A", "B", "C", "D"]), 0.8)     ] -bipartitionsFirstTree :: Set (Bipartition BS.ByteString)+bipartitionsFirstTree :: Set (Bipartition Name) bipartitionsFirstTree =   S.fromList     [ bpUnsafe (sfrom ["B"]) (sfrom ["A", "C", "D", "E"]),@@ -57,7 +56,7 @@       bpUnsafe (sfrom ["E"]) (sfrom ["A", "B", "C", "D"])     ] -bipartitionsSecondTree :: Set (Bipartition BS.ByteString)+bipartitionsSecondTree :: Set (Bipartition Name) bipartitionsSecondTree =   S.fromList     [ bpUnsafe (sfrom ["B"]) (sfrom ["A", "C", "D", "E"]),

@@ -16,7 +16,6 @@   ) where -import qualified Data.ByteString.Char8 as BS import ELynx.Tools import ELynx.Tree import ELynx.Tree.Arbitrary ()@@ -26,13 +25,13 @@ treeFileSimple :: FilePath treeFileSimple = "data/TreeDist.trees" -getSimpleTrees :: IO (Forest Phylo BS.ByteString)+getSimpleTrees :: IO (Forest Phylo Name) getSimpleTrees = parseFileWith (someNewick Standard) treeFileSimple  treeFileMany :: FilePath treeFileMany = "data/Many.trees" -getManyTrees :: IO (Forest Phylo BS.ByteString)+getManyTrees :: IO (Forest Phylo Name) getManyTrees = parseFileWith (someNewick Standard) treeFileMany  -- I used treedist from Phylip to get the correct results.@@ -180,19 +179,19 @@       Node () ' ' [Node () 'B' [], Node () ' ' [Node () 'D' [], Node () 'E' []]]     ] -incSplitTree1a :: Tree Phylo BS.ByteString+incSplitTree1a :: Tree Phylo Name incSplitTree1a = parseByteStringWith (oneNewick IqTree) "((a,b)0.7,(c,d));" -incSplitTree1b :: Tree Phylo BS.ByteString+incSplitTree1b :: Tree Phylo Name incSplitTree1b = parseByteStringWith (oneNewick IqTree) "((a,b)0.7,c,d);" -incSplitTree2 :: Tree Phylo BS.ByteString+incSplitTree2 :: Tree Phylo Name incSplitTree2 = parseByteStringWith (oneNewick IqTree) "((a,c),(b,d));" -incSplitTree3 :: Tree Phylo BS.ByteString+incSplitTree3 :: Tree Phylo Name incSplitTree3 = parseByteStringWith (oneNewick IqTree) "(((a,b)0.7,c),(d,e));" -incSplitTree4 :: Tree Phylo BS.ByteString+incSplitTree4 :: Tree Phylo Name incSplitTree4 = parseByteStringWith (oneNewick IqTree) "(((a,c),b),(d,e));"  -- Compute distances between adjacent pairs of a list of input trees. Use given

@@ -16,7 +16,6 @@ where  import Data.Bifunctor-import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BL import ELynx.Tools import ELynx.Tree@@ -24,7 +23,7 @@ import Test.Hspec import Test.QuickCheck hiding (label) -samplePhyloByteStringTree :: Tree Phylo BS.ByteString+samplePhyloByteStringTree :: Tree Phylo Name samplePhyloByteStringTree = parseByteStringWith (newick Standard) sampleNewickByteString1  sampleNewickByteString1 :: BL.ByteString@@ -37,7 +36,7 @@     -- We have to convert Int to ByteString, but we cannot use     -- arbitrary instances with ByteStrings because many     -- characters are disallowed and break the Newick string.-    second (BL.toStrict . getName) t+    second getName t  spec :: Spec spec = describe "parseByteStringWith newick $ toNewickPhyloByteString" $ do

@@ -16,12 +16,11 @@   ) where -import qualified Data.ByteString.Char8 as BS import ELynx.Tools import ELynx.Tree import Test.Hspec -tree :: Tree Phylo BS.ByteString+tree :: Tree Phylo Name tree =   Node     (Phylo Nothing Nothing)

@@ -56,7 +56,7 @@ sampleNewickEmptyByteString :: BS.ByteString sampleNewickEmptyByteString = "(,(,,),);" -sampleNewickEmpty :: Tree Phylo BS.ByteString+sampleNewickEmpty :: Tree Phylo Name sampleNewickEmpty =   Node     noPL

@@ -16,7 +16,6 @@   ) where -import qualified Data.ByteString.Char8 as BS import ELynx.Tools import ELynx.Tree import Test.Hspec@@ -27,7 +26,7 @@ noPL :: Phylo noPL = Phylo Nothing Nothing -res :: Tree Phylo BS.ByteString+res :: Tree Phylo Name res =   Node     noPL

@@ -42,7 +42,7 @@ prop_roots :: Tree () a -> Bool prop_roots t@(Node _ _ [_, _])   | length (leaves t) == 2 = (length <$> roots t) == Right 1-  | otherwise = (length <$> roots t) == (Right $ length (labels t) - 2)+  | otherwise = (length <$> roots t) == Right (length (labels t) - 2) prop_roots _ = True  -- -- Skip leaves and trees with multifurcating root nodes.@@ -91,7 +91,7 @@  -- -- TODO. -- prop_bifurcating_tree---   :: (Ord a, Measurable a, Named a, BranchSupported a) => Tree a -> Bool+--   :: (Ord a, Measurable a, Named a, Supported a) => Tree a -> Bool -- prop_bifurcating_tree t = partitions (resolve t) == empty  prop_roots_total_length :: Tree Length a -> Bool

@@ -16,7 +16,6 @@   ) where -import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BL import Data.Maybe import ELynx.Tools@@ -38,11 +37,11 @@ sampleTreeBS :: BL.ByteString sampleTreeBS = "(Aeropyrum0:0.5478645225,(((((((((Arabidopsi:0.0701001024,Oryza_sati:0.0765988261):0.0309636193,Gymnosperm:0.0520325624):0.0338982245,Physcomitr:0.0768008916):0.0895714685,(Chlamydomo:0.1136227755,Dunaliella:0.1406347323):0.1117340620):0.0818876186,Rhodophyta:0.3405656487):0.0363527066,((((((Babesia_bo:0.1646969208,Theileria0:0.1519889486):0.1908081096,Plasmodium:0.3250696762):0.0637865908,(Toxoplasma:0.1153570425,Eimeria000:0.1671916078):0.0980136930):0.0518956330,Cryptospor:0.3175062809):0.1607708388,Ciliophora:0.5687502950):0.0624078848,(Phytophtho:0.2016424948,((Thalassios:0.1202730781,Phaeodacty:0.1290341329):0.1772775509,Phaeophyce:0.1989260715):0.0312359673):0.1154768302):0.0311952864):0.0149160316,(((((((((Candida_al:0.1027755272,Saccharomy:0.1190206560):0.1333487870,Neurospora:0.1977309079):0.0522926266,Schizosacc:0.2019603227):0.0567441011,(Cryptococc:0.1948614959,Ustilago_m:0.1564451295):0.0775729694):0.0323959951,Glomus_int:0.1573670796):0.0194701292,Chytridiom:0.2228415254):0.0384370601,Encephalit:1.4622174644):0.0416231688,(((Drosophila:0.2160627753,(Mammalians:0.1080484094,Tunicates0:0.1739253014):0.0289624371):0.0346633757,Hydrozoa00:0.2058137032):0.0480963050,Monosiga_b:0.3020637584):0.0654894239):0.0380915725,(Dictyostel:0.3453588998,Mastigamoe:0.3844779231):0.0478795653):0.0129578395):1.7592083381,((Archaeoglo:0.5402784445,Methanococ:0.4088567459):0.0993669265,Pyrococcus:0.4058713829):0.1734405968):0.2193511807,Pyrobaculu:0.7507718047):0.1646616482,Sulfolobus:0.5404967897);" -largeTree :: Tree Phylo BS.ByteString+largeTree :: Tree Phylo Name largeTree = parseByteStringWith (newick Standard) sampleTreeBS -subSampleLargeTree :: Tree Phylo BS.ByteString-subSampleLargeTree = fromJust $ dropLeavesWith ((/= 'P') . BS.head) largeTree+subSampleLargeTree :: Tree Phylo Name+subSampleLargeTree = fromJust $ dropLeavesWith ((/= 'P') . BL.head . fromName) largeTree  spec :: Spec spec = do

@@ -16,15 +16,14 @@   ) where -import qualified Data.ByteString.Char8 as BS import ELynx.Tools import ELynx.Tree import Test.Hspec -collapseTree :: Tree Phylo BS.ByteString+collapseTree :: Tree Phylo Name collapseTree = parseByteStringWith (oneNewick IqTree) "((a,b),(c,d));" -collapseStarTree :: Tree Phylo BS.ByteString+collapseStarTree :: Tree Phylo Name collapseStarTree = parseByteStringWith (oneNewick Standard) "(a[1.0],b[1.0],c[1.0],d[1.0])[1.0];"  spec :: Spec