diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,7 +2,14 @@ # Changelog for ELynx -## Version 0.3.1; in development +## Version 0.3.2; in development + + +## Version 0.3.1 + +- Use Attoparsec. +- Use ByteString consistently. +- Remove elynx-tools dependency from libaries. ## Version 0.3.0 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ # The ELynx Suite -Version: 0.3.0. +Version: 0.3.1. Reproducible evolution made easy.

@@ -90,9 +90,9 @@ slynx --help | head -n -16 - ELynx Suite version 0.3.0. + ELynx Suite version 0.3.1. Developed by Dominik Schrempf. - Compiled on July 30, 2020, at 12:40 pm, UTC. + Compiled on August 3, 2020, at 12:12 pm, UTC. Usage: slynx [-v|--verbosity VALUE] [-o|--output-file-basename NAME] [-f|--force] COMMAND @@ -136,9 +136,9 @@ slynx concatenate --help - ELynx Suite version 0.3.0. + ELynx Suite version 0.3.1. Developed by Dominik Schrempf. - Compiled on July 30, 2020, at 12:40 pm, UTC. + Compiled on August 3, 2020, at 12:12 pm, UTC. Usage: slynx concatenate (-a|--alphabet NAME) INPUT-FILE Concatenate sequences found in input files. @@ -157,9 +157,9 @@ slynx examine --help - ELynx Suite version 0.3.0. + ELynx Suite version 0.3.1. Developed by Dominik Schrempf. - Compiled on July 30, 2020, at 12:40 pm, UTC. + Compiled on August 3, 2020, at 12:12 pm, UTC. Usage: slynx examine (-a|--alphabet NAME) INPUT-FILE [--per-site] Examine sequences. If data is a multi sequence alignment, additionally analyze columns. @@ -179,9 +179,9 @@ slynx filter-rows --help - ELynx Suite version 0.3.0. + ELynx Suite version 0.3.1. Developed by Dominik Schrempf. - Compiled on July 30, 2020, at 12:40 pm, UTC. + Compiled on August 3, 2020, at 12:12 pm, UTC. Usage: slynx filter-rows (-a|--alphabet NAME) INPUT-FILE [--longer-than LENGTH] [--shorter-than LENGTH] [--standard-characters] @@ -202,9 +202,9 @@ slynx filter-columns --help - ELynx Suite version 0.3.0. + ELynx Suite version 0.3.1. Developed by Dominik Schrempf. - Compiled on July 30, 2020, at 12:40 pm, UTC. + Compiled on August 3, 2020, at 12:12 pm, UTC. Usage: slynx filter-columns (-a|--alphabet NAME) INPUT-FILE [--standard-chars DOUBLE] @@ -226,9 +226,9 @@ slynx simulate --help - ELynx Suite version 0.3.0. + ELynx Suite version 0.3.1. Developed by Dominik Schrempf. - Compiled on July 30, 2020, at 12:40 pm, UTC. + Compiled on August 3, 2020, at 12:12 pm, UTC. Usage: slynx simulate (-t|--tree-file Name) [-s|--substitution-model MODEL] [-m|--mixture-model MODEL] [-e|--edm-file NAME] @@ -305,9 +305,9 @@ slynx sub-sample --help - ELynx Suite version 0.3.0. + ELynx Suite version 0.3.1. Developed by Dominik Schrempf. - Compiled on July 30, 2020, at 12:40 pm, UTC. + Compiled on August 3, 2020, at 12:12 pm, UTC. Usage: slynx sub-sample (-a|--alphabet NAME) INPUT-FILE (-n|--number-of-sites INT) @@ -335,9 +335,9 @@ slynx translate --help - ELynx Suite version 0.3.0. + ELynx Suite version 0.3.1. Developed by Dominik Schrempf. - Compiled on July 30, 2020, at 12:40 pm, UTC. + Compiled on August 3, 2020, at 12:12 pm, UTC. Usage: slynx translate (-a|--alphabet NAME) INPUT-FILE (-r|--reading-frame INT) (-u|--universal-code CODE) @@ -360,9 +360,9 @@ tlynx --help | head -n -16 - ELynx Suite version 0.3.0. + ELynx Suite version 0.3.1. Developed by Dominik Schrempf. - Compiled on July 30, 2020, at 12:40 pm, UTC. + Compiled on August 3, 2020, at 12:12 pm, UTC. Usage: tlynx [-v|--verbosity VALUE] [-o|--output-file-basename NAME] [-f|--force] COMMAND @@ -399,9 +399,9 @@ tlynx compare --help - ELynx Suite version 0.3.0. + ELynx Suite version 0.3.1. Developed by Dominik Schrempf. - Compiled on July 30, 2020, at 12:40 pm, UTC. + Compiled on August 3, 2020, at 12:12 pm, UTC. Usage: tlynx compare [-n|--normalize] [-b|--bipartitions] [-t|--intersect] [-f|--newick-format FORMAT] NAMES @@ -428,9 +428,9 @@ tlynx examine --help - ELynx Suite version 0.3.0. + ELynx Suite version 0.3.1. Developed by Dominik Schrempf. - Compiled on July 30, 2020, at 12:40 pm, UTC. + Compiled on August 3, 2020, at 12:12 pm, UTC. Usage: tlynx examine INPUT-FILE [-f|--newick-format FORMAT] Compute summary statistics of phylogenetic trees. @@ -452,9 +452,9 @@ tlynx simulate --help - ELynx Suite version 0.3.0. + ELynx Suite version 0.3.1. Developed by Dominik Schrempf. - Compiled on July 30, 2020, at 12:40 pm, UTC. + Compiled on August 3, 2020, at 12:12 pm, UTC. Usage: tlynx simulate [-t|--nTrees INT] [-n|--nLeaves INT] [-H|--height DOUBLE] [-M|--condition-on-mrca] [-l|--lambda DOUBLE] @@ -491,9 +491,9 @@ elynx --help | head -n -16 - ELynx Suite version 0.3.0. + ELynx Suite version 0.3.1. Developed by Dominik Schrempf. - Compiled on July 30, 2020, at 12:40 pm, UTC. + Compiled on August 3, 2020, at 12:12 pm, UTC. Usage: elynx COMMAND Validate and redo past ELynx analyses diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -12,7 +12,7 @@ module Main where import Criterion.Main -import Data.ByteString.Lazy.Char8 (ByteString) +import qualified Data.ByteString.Char8 as BS import ELynx.Data.Tree import ELynx.Import.Tree.Newick import ELynx.Tools @@ -20,7 +20,7 @@ treeFileMany :: FilePath treeFileMany = "data/Many.trees" -getManyTrees :: IO (Forest Phylo ByteString) +getManyTrees :: IO (Forest Phylo BS.ByteString) getManyTrees = parseFileWith (someNewick Standard) treeFileMany main :: IO () diff --git a/elynx-tree.cabal b/elynx-tree.cabal --- a/elynx-tree.cabal +++ b/elynx-tree.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: df9f8f1cb0b1f1f6bac542cb0c44ceb8e3530eb04ea14e29c0b5bb4be0e831f3 +-- hash: 5876c21cdef387a8327af59315c4809662b893bf5daeb4f5e60874063f34384f name: elynx-tree -version: 0.3.0 +version: 0.3.1 synopsis: Handle phylogenetic trees description: Examine, compare, and simulate phylogenetic trees in a reproducible way. Please see the README on GitHub at . category: Bioinformatics @@ -65,19 +65,18 @@ ghc-options: -Wall -fllvm build-depends: aeson + , attoparsec , base >=4.7 && <5 , bytestring , comonad , containers , deepseq + , double-conversion , elynx-nexus - , elynx-tools , math-functions - , megaparsec , mwc-random , primitive , statistics - , vector default-language: Haskell2010 test-suite tree-test @@ -101,14 +100,13 @@ ghc-options: -Wall -fllvm build-depends: QuickCheck + , attoparsec , base >=4.7 && <5 , bytestring , containers , elynx-tools , elynx-tree , hspec - , hspec-megaparsec - , megaparsec default-language: Haskell2010 benchmark tree-bench @@ -122,7 +120,6 @@ build-depends: base >=4.7 && <5 , bytestring - , containers , criterion , elynx-tools , elynx-tree diff --git a/src/ELynx/Data/Tree/Measurable.hs b/src/ELynx/Data/Tree/Measurable.hs --- a/src/ELynx/Data/Tree/Measurable.hs +++ b/src/ELynx/Data/Tree/Measurable.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -- | -- Module : ELynx.Data.Tree.Measurable -- Description : Measurable branch labels @@ -21,7 +19,6 @@ rootHeight, distancesOriginLeaves, totalBranchLength, - summarizeBranchLengths, normalizeBranchLengths, normalizeHeight, ultrametric, @@ -31,18 +28,11 @@ import Data.Bifoldable import Data.Bifunctor -import Data.ByteString.Lazy.Char8 (ByteString) -import qualified Data.ByteString.Lazy.Char8 as L import ELynx.Data.Tree.Rooted -import ELynx.Tools -import Text.Printf -- | Branch length. type BranchLength = Double -pretty :: BranchLength -> String -pretty = printf "%.5f" - -- | A branch label with measurable and modifiable branch length. class Measurable e where -- | Length of attached branch. @@ -101,27 +91,6 @@ totalBranchLength :: Measurable e => Tree e a -> BranchLength totalBranchLength = bifoldl' (+) const 0 . first getLen -prettyRow :: String -> String -> ByteString -prettyRow name val = alignLeft 33 n <> alignRight 8 v - where - n = L.pack name - v = L.pack val - --- | Examine branches of a tree. -summarizeBranchLengths :: Measurable e => Tree e a -> ByteString -summarizeBranchLengths t = - L.intercalate - "\n" - [ prettyRow "Origin height: " $ pretty h, - prettyRow "Average distance origin to leaves: " $ pretty h', - prettyRow "Total branch length: " $ pretty b - ] - where - n = length $ leaves t - h = height t - h' = sum (distancesOriginLeaves t) / fromIntegral n - b = totalBranchLength t - -- | 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 @@ -133,6 +102,15 @@ normalizeHeight t = first (apply (/ h)) t where h = height t + +eps :: Double +eps = 1e-12 + +allNearlyEqual :: [Double] -> Bool +allNearlyEqual [] = True +allNearlyEqual xs = all (\y -> eps > abs (x - y)) (tail xs) + where + x = head xs -- | Check if a tree is ultrametric. ultrametric :: Measurable e => Tree e a -> Bool diff --git a/src/ELynx/Data/Tree/Named.hs b/src/ELynx/Data/Tree/Named.hs --- a/src/ELynx/Data/Tree/Named.hs +++ b/src/ELynx/Data/Tree/Named.hs @@ -14,21 +14,30 @@ ) where -import Data.ByteString.Lazy.Builder (char8, doubleDec, intDec, toLazyByteString) -import Data.ByteString.Lazy.Char8 (ByteString) +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 -- | Data types with names. class Named a where - getName :: a -> ByteString + -- Use lazy byte strings because Newick strings are built using chunks. + getName :: a -> BL.ByteString +instance Named () where + getName = const BL.empty + instance Named Int where - getName = toLazyByteString . intDec + getName = BB.toLazyByteString . BB.intDec instance Named Double where - getName = toLazyByteString . doubleDec + getName = BL.fromStrict . toShortest instance Named Char where - getName = toLazyByteString . char8 + getName = BB.toLazyByteString . BB.char8 -instance Named ByteString where +instance Named BL.ByteString where getName = id + +instance Named BS.ByteString where + getName = BL.fromStrict diff --git a/src/ELynx/Export/Tree/Newick.hs b/src/ELynx/Export/Tree/Newick.hs --- a/src/ELynx/Export/Tree/Newick.hs +++ b/src/ELynx/Export/Tree/Newick.hs @@ -16,38 +16,38 @@ -- See nomenclature in 'ELynx.Data.Tree.Tree'. module ELynx.Export.Tree.Newick ( toNewick, + toNewickBuilder, ) where -import Data.ByteString.Lazy.Builder (Builder) -import qualified Data.ByteString.Lazy.Builder as L -import Data.ByteString.Lazy.Char8 (ByteString) +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Lazy.Char8 as BL import Data.List (intersperse) import ELynx.Data.Tree.Named import ELynx.Data.Tree.Phylogeny import ELynx.Data.Tree.Rooted -import ELynx.Tools -toNewickBuilder :: Named a => Tree Phylo a -> Builder -toNewickBuilder t = go t <> L.word8 (c2w ';') +-- | See 'toNewick'. +toNewickBuilder :: Named a => Tree Phylo a -> BB.Builder +toNewickBuilder t = go t <> BB.char8 ';' where go (Node b l []) = lbl b l go (Node b l ts) = - L.word8 (c2w '(') - <> mconcat (intersperse (L.word8 $ c2w ',') $ map go ts) - <> L.word8 (c2w ')') + BB.char8 '(' + <> mconcat (intersperse (BB.char8 ',') $ map go ts) + <> BB.char8 ')' <> lbl b l - mBrSupBuilder x = maybe mempty (\bs -> L.word8 (c2w '[') <> L.doubleDec bs <> L.word8 (c2w ']')) (brSup x) - mBrLenBuilder x = maybe mempty (\bl -> L.word8 (c2w ':') <> L.doubleDec bl) (brLen x) + mBrSupBuilder x = maybe mempty (\bs -> BB.char8 '[' <> BB.doubleDec bs <> BB.char8 ']') (brSup x) + mBrLenBuilder x = maybe mempty (\bl -> BB.char8 ':' <> BB.doubleDec bl) (brLen x) lbl x y = - L.lazyByteString (getName y) + BB.lazyByteString (getName y) <> mBrLenBuilder x -- After reading several discussion, I go for the "more semantical -- form" with branch support values in square brackets. <> mBrSupBuilder x --- | General conversion of a tree into a Newick 'L.Bytestring'. Use provided +-- | 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. -toNewick :: Named a => Tree Phylo a -> ByteString -toNewick = L.toLazyByteString . toNewickBuilder +toNewick :: Named a => Tree Phylo a -> BL.ByteString +toNewick = BB.toLazyByteString . toNewickBuilder diff --git a/src/ELynx/Export/Tree/Nexus.hs b/src/ELynx/Export/Tree/Nexus.hs --- a/src/ELynx/Export/Tree/Nexus.hs +++ b/src/ELynx/Export/Tree/Nexus.hs @@ -16,7 +16,7 @@ ) where -import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy.Char8 as BL import ELynx.Data.Tree.Named import ELynx.Data.Tree.Phylogeny import ELynx.Data.Tree.Rooted @@ -24,8 +24,8 @@ import ELynx.Export.Tree.Newick -- | Export a list of (NAME, TREE) to a Nexus file. -toNexusTrees :: Named a => [(ByteString, Tree Phylo a)] -> ByteString +toNexusTrees :: Named a => [(BL.ByteString, Tree Phylo a)] -> BL.ByteString toNexusTrees ts = toNexus "TREES" (map tree ts) -tree :: Named a => (ByteString, Tree Phylo a) -> ByteString +tree :: Named a => (BL.ByteString, Tree Phylo a) -> BL.ByteString tree (n, t) = " TREE " <> n <> " = " <> toNewick t diff --git a/src/ELynx/Import/Tree/Newick.hs b/src/ELynx/Import/Tree/Newick.hs --- a/src/ELynx/Import/Tree/Newick.hs +++ b/src/ELynx/Import/Tree/Newick.hs @@ -1,8 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} --- TODO: Use 'between' for forests. - --- | -- Module : ELynx.Import.Tree.Newick -- Description : Import Newick trees -- Copyright : (c) Dominik Schrempf 2020 @@ -22,12 +19,11 @@ -- In particular, no conversion from _ to (space) is done right now. -- -- For a description of rooted 'Tree's, please see the 'ELynx.Data.Tree.Rooted' + +-- | -- module header. module ELynx.Import.Tree.Newick - ( Parser, - - -- * Newick tree format - NewickFormat (..), + ( NewickFormat (..), description, newick, oneNewick, @@ -35,24 +31,16 @@ ) where -import Data.ByteString.Lazy (ByteString) -import qualified Data.ByteString.Lazy as L -import Data.Void -import Data.Word +import Control.Applicative +import Data.Aeson (FromJSON, ToJSON) +import Data.Attoparsec.ByteString.Char8 +import qualified Data.ByteString.Char8 as BS import ELynx.Data.Tree.Measurable import ELynx.Data.Tree.Phylogeny -import ELynx.Data.Tree.Rooted hiding (label) +import ELynx.Data.Tree.Rooted hiding (forest, label) import ELynx.Data.Tree.Supported -import ELynx.Tools -import Text.Megaparsec -import Text.Megaparsec.Byte -import Text.Megaparsec.Byte.Lexer - ( decimal, - float, - ) - --- | Shortcut. -type Parser = Parsec Void ByteString +import GHC.Generics +import Prelude hiding (takeWhile) -- | Newick tree format. -- @@ -77,133 +65,117 @@ "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." -- | Parse a single Newick tree. Also succeeds when more trees follow. -newick :: NewickFormat -> Parser (Tree Phylo ByteString) +newick :: NewickFormat -> Parser (Tree Phylo BS.ByteString) newick Standard = newickStandard newick IqTree = newickIqTree newick RevBayes = newickRevBayes -- | Parse a single Newick tree. Fails when end of file is not reached. -oneNewick :: NewickFormat -> Parser (Tree Phylo ByteString) +oneNewick :: NewickFormat -> Parser (Tree Phylo BS.ByteString) oneNewick Standard = oneNewickStandard oneNewick IqTree = oneNewickIqTree oneNewick RevBayes = oneNewickRevBayes -- | Parse one or more Newick trees until end of file. -someNewick :: NewickFormat -> Parser (Forest Phylo ByteString) +someNewick :: NewickFormat -> Parser (Forest Phylo BS.ByteString) someNewick Standard = someNewickStandard someNewick IqTree = someNewickIqTree someNewick RevBayes = someNewickRevBayes -w :: Char -> Parser Word8 -w = char . c2w - -- Parse a single Newick tree. Also succeeds when more trees follow. -newickStandard :: Parser (Tree Phylo ByteString) -newickStandard = space *> tree <* w ';' <* space "newickStandard" +newickStandard :: Parser (Tree Phylo BS.ByteString) +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 ByteString) -oneNewickStandard = newickStandard <* eof "oneNewickStandard" +oneNewickStandard :: Parser (Tree Phylo BS.ByteString) +oneNewickStandard = newickStandard <* endOfInput "oneNewickStandard" -- Parse one ore more Newick trees until end of file. -someNewickStandard :: Parser (Forest Phylo ByteString) -someNewickStandard = some newickStandard <* eof "someNewickStandard" +someNewickStandard :: Parser (Forest Phylo BS.ByteString) +someNewickStandard = some newickStandard <* endOfInput "someNewickStandard" -tree :: Parser (Tree Phylo ByteString) +tree :: Parser (Tree Phylo BS.ByteString) tree = branched <|> leaf "tree" -branched :: Parser (Tree Phylo ByteString) -branched = label "branched" $ do - f <- forestP +branched :: Parser (Tree Phylo BS.ByteString) +branched = ( "branched") $ do + f <- forest n <- name p <- phylo return $ Node p n f -- A 'forest' is a set of trees separated by @,@ and enclosed by parentheses. -forestP :: Parser (Forest Phylo ByteString) -forestP = between (w '(') (w ')') (tree `sepBy1` w ',') "forestP" - -branchSupport :: Parser (Maybe BranchSupport) -branchSupport = label "branchSupport" $ - optional $ - try $ - do - _ <- w '[' - s <- float <|> decimalAsDouble - _ <- w ']' - return s +forest :: Parser (Forest Phylo BS.ByteString) +forest = char '(' *> (tree `sepBy1` char ',') <* char ')' "forest" -- A 'leaf' has a 'name' and a 'phylo' branch. -leaf :: Parser (Tree Phylo ByteString) -leaf = label "leaf" $ do +leaf :: Parser (Tree Phylo BS.ByteString) +leaf = ( "leaf") $ do n <- name p <- phylo return $ Node p n [] -checkNameCharacter :: Word8 -> Bool -checkNameCharacter c = c `notElem` map c2w " :;()[]," +nameChar :: Char -> Bool +nameChar c = c `notElem` " :;()[]," -- A name can be any string of printable characters except blanks, colons, -- semicolons, parentheses, and square brackets (and commas). -name :: Parser ByteString -name = L.pack <$> many (satisfy checkNameCharacter) "name" +name :: Parser BS.ByteString +name = takeWhile nameChar "name" phylo :: Parser Phylo -phylo = Phylo <$> branchLength <*> branchSupport "phylo" +phylo = Phylo <$> optional branchLength <*> optional branchSupport "phylo" -- Branch length. -branchLength :: Parser (Maybe BranchLength) -branchLength = optional (w ':' *> branchLengthGiven) "branchLength" - -branchLengthGiven :: Parser Double -branchLengthGiven = try float <|> decimalAsDouble "branchLengthGiven" +branchLength :: Parser BranchLength +branchLength = char ':' *> double "branchLength" -decimalAsDouble :: Parser Double -decimalAsDouble = fromIntegral <$> (decimal :: Parser Int) "decimalAsDouble" +branchSupport :: Parser BranchSupport +branchSupport = ( "branchSupport") $ + do + _ <- char '[' + s <- double + _ <- char ']' + return 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 ByteString) -newickIqTree = space *> treeIqTree <* w ';' <* space "newickIqTree" +newickIqTree :: Parser (Tree Phylo BS.ByteString) +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 ByteString) -oneNewickIqTree = newickIqTree <* eof "oneNewickIqTree" +oneNewickIqTree :: Parser (Tree Phylo BS.ByteString) +oneNewickIqTree = newickIqTree <* endOfInput "oneNewickIqTree" -- See 'newickIqTree'. Parse one ore more Newick trees until end of file. -someNewickIqTree :: Parser (Forest Phylo ByteString) -someNewickIqTree = some newickIqTree <* eof "someNewickIqTree" +someNewickIqTree :: Parser (Forest Phylo BS.ByteString) +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 ByteString) +treeIqTree :: Parser (Tree Phylo BS.ByteString) treeIqTree = branchedIqTree <|> leaf "treeIqTree" -- IQ-TREE stores the branch support as node names after the closing bracket of a forest. -branchedIqTree :: Parser (Tree Phylo ByteString) -branchedIqTree = label "branchedIqTree" $ do +branchedIqTree :: Parser (Tree Phylo BS.ByteString) +branchedIqTree = ( "branchedIqTree") $ do f <- forestIqTree - s <- branchSupportIqTree + s <- optional double n <- name - b <- branchLength + 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 ByteString) -forestIqTree = label "forestIqTree" $ do - _ <- w '(' - f <- treeIqTree `sepBy1` w ',' - _ <- w ')' +forestIqTree :: Parser (Forest Phylo BS.ByteString) +forestIqTree = ( "forestIqTree") $ do + _ <- char '(' + f <- treeIqTree `sepBy1` char ',' + _ <- char ')' return f --- TODO: Same here, why try? --- IQ-TREE stores the branch support as node names after the closing bracket of a forest. -branchSupportIqTree :: Parser (Maybe BranchSupport) -branchSupportIqTree = label "branchSupportIqTree" $ optional $ try float <|> try decimalAsDouble - -------------------------------------------------------------------------------- -- RevBayes. @@ -212,54 +184,52 @@ -- trees follow. -- -- XXX: Key value pairs are ignored at the moment. -newickRevBayes :: Parser (Tree Phylo ByteString) +newickRevBayes :: Parser (Tree Phylo BS.ByteString) newickRevBayes = - space *> optional brackets *> treeRevBayes <* w ';' <* space "newickRevBayes" + skipWhile isSpace *> optional brackets *> treeRevBayes <* char ';' <* skipWhile isSpace "newickRevBayes" -- See 'newickRevBayes'. Parse a single Newick tree. Fails when end of file is -- not reached. -oneNewickRevBayes :: Parser (Tree Phylo ByteString) -oneNewickRevBayes = newickRevBayes <* eof "oneNewickRevBayes" +oneNewickRevBayes :: Parser (Tree Phylo BS.ByteString) +oneNewickRevBayes = newickRevBayes <* endOfInput "oneNewickRevBayes" -- See 'newickRevBayes'. Parse one ore more Newick trees until end of file. -someNewickRevBayes :: Parser (Forest Phylo ByteString) -someNewickRevBayes = some newickRevBayes <* eof "someNewickRevBayes" +someNewickRevBayes :: Parser (Forest Phylo BS.ByteString) +someNewickRevBayes = some newickRevBayes <* endOfInput "someNewickRevBayes" -treeRevBayes :: Parser (Tree Phylo ByteString) +treeRevBayes :: Parser (Tree Phylo BS.ByteString) treeRevBayes = branchedRevBayes <|> leafRevBayes "treeRevBayes" -branchedRevBayes :: Parser (Tree Phylo ByteString) -branchedRevBayes = label "branchedRevgBayes" $ do +branchedRevBayes :: Parser (Tree Phylo BS.ByteString) +branchedRevBayes = ( "branchedRevgBayes") $ do f <- forestRevBayes n <- nameRevBayes - b <- branchLengthRevBayes + b <- optional branchLengthRevBayes return $ Node (Phylo b Nothing) n f -forestRevBayes :: Parser (Forest Phylo ByteString) -forestRevBayes = label "forestRevBayes" $ do - _ <- w '(' - f <- treeRevBayes `sepBy1` w ',' - _ <- w ')' +forestRevBayes :: Parser (Forest Phylo BS.ByteString) +forestRevBayes = ( "forestRevBayes") $ do + _ <- char '(' + f <- treeRevBayes `sepBy1` char ',' + _ <- char ')' return f -nameRevBayes :: Parser ByteString +nameRevBayes :: Parser BS.ByteString nameRevBayes = name <* optional brackets "nameRevBayes" -branchLengthRevBayes :: Parser (Maybe BranchLength) +branchLengthRevBayes :: Parser BranchLength branchLengthRevBayes = branchLength <* optional brackets "branchLengthRevBayes" -leafRevBayes :: Parser (Tree Phylo ByteString) -leafRevBayes = label "leafRevBayes" $ do +leafRevBayes :: Parser (Tree Phylo BS.ByteString) +leafRevBayes = ( "leafRevBayes") $ do n <- nameRevBayes - b <- branchLengthRevBayes + b <- optional branchLengthRevBayes return $ Node (Phylo b Nothing) n [] -- Drop anything between brackets. brackets :: Parser () -brackets = label "brackets" $ do - _ <- - between - (w '[') - (w ']') - (takeWhileP (Just "allCharsButBracketEnd") (/= c2w ']')) +brackets = ( "brackets") $ do + _ <- char '[' + _ <- takeWhile (/= ']') + _ <- char ']' return () diff --git a/src/ELynx/Import/Tree/Nexus.hs b/src/ELynx/Import/Tree/Nexus.hs --- a/src/ELynx/Import/Tree/Nexus.hs +++ b/src/ELynx/Import/Tree/Nexus.hs @@ -16,30 +16,30 @@ ) where -import Data.ByteString.Internal (c2w) -import Data.ByteString.Lazy (ByteString, pack) +import Control.Applicative +import Data.Attoparsec.ByteString.Char8 +import qualified Data.ByteString.Char8 as BS import ELynx.Data.Tree.Phylogeny import ELynx.Data.Tree.Rooted -import ELynx.Import.Nexus hiding (Parser) +import ELynx.Import.Nexus import ELynx.Import.Tree.Newick -import Text.Megaparsec -import Text.Megaparsec.Byte +import Prelude hiding (takeWhile) -- | Parse a Nexus files with a TREES block. -nexusTrees :: NewickFormat -> Parser [(ByteString, Tree Phylo ByteString)] +nexusTrees :: NewickFormat -> Parser [(BS.ByteString, Tree Phylo BS.ByteString)] nexusTrees = nexus . trees -trees :: NewickFormat -> Block [(ByteString, Tree Phylo ByteString)] +trees :: NewickFormat -> Block [(BS.ByteString, Tree Phylo BS.ByteString)] trees f = Block "TREES" (some $ namedNewick f) -namedNewick :: NewickFormat -> Parser (ByteString, Tree Phylo ByteString) +namedNewick :: NewickFormat -> Parser (BS.ByteString, Tree Phylo BS.ByteString) namedNewick f = do - _ <- space + _ <- skipWhile isSpace _ <- string "TREE" - _ <- space - n <- some alphaNumChar - _ <- space - _ <- char $ c2w '=' - _ <- space + _ <- skipWhile isSpace + n <- takeWhile1 (\x -> isAlpha_ascii x || isDigit x) + _ <- skipWhile isSpace + _ <- char '=' + _ <- skipWhile isSpace t <- newick f - return (pack n, t) + return (n, t) diff --git a/src/ELynx/Simulate/PointProcess.hs b/src/ELynx/Simulate/PointProcess.hs --- a/src/ELynx/Simulate/PointProcess.hs +++ b/src/ELynx/Simulate/PointProcess.hs @@ -29,7 +29,8 @@ import Control.Monad import Control.Monad.Primitive -import Data.List (mapAccumL) +import Data.Function +import Data.List import Data.Sequence (Seq) import qualified Data.Sequence as S import ELynx.Data.Tree.Measurable @@ -42,7 +43,6 @@ import ELynx.Distribution.TimeOfOrigin import ELynx.Distribution.TimeOfOriginNearCritical import ELynx.Distribution.Types -import ELynx.Tools import qualified Statistics.Distribution as D ( genContVar, ) @@ -54,6 +54,23 @@ epsNearCriticalTimeOfOrigin :: Double epsNearCriticalTimeOfOrigin = 1e-8 +eps :: Double +eps = 1e-12 + +(=~=) :: Double -> Double -> Bool +x =~= y = eps > abs (x - y) + +-- Sort a list and also return original indices. +sortListWithIndices :: Ord a => [a] -> [(a, Int)] +sortListWithIndices xs = sortBy (compare `on` fst) $ zip xs ([0 ..] :: [Int]) + +-- Insert element into random position of list. +randomInsertList :: PrimMonad m => a -> [a] -> Gen (PrimState m) -> m [a] +randomInsertList e v g = do + let l = length v + i <- uniformR (0, l) g + return $ take i v ++ [e] ++ drop i v + -- | A __point process__ for \(n\) points and of age \(t_{or}\) is defined as -- follows. Draw $n$ points on the horizontal axis at \(1,2,\ldots,n\). Pick -- \(n-1\) points at locations \((i+1/2, s_i)\), \(i=1,2,\ldots,n-1\); @@ -148,10 +165,10 @@ return $ PointProcess [0 .. (n - 1)] vs' t | otherwise = error "simulate: Fell through guard, this should never happen." --- | Sort the values of a point process and their indices to be (the indices +-- Sort the values of a point process and their indices to be (the indices -- that they will have while creating the tree). -sort :: (Ord b) => PointProcess a b -> ([b], [Int]) -sort (PointProcess _ vs _) = (vsSorted, isSorted) +sortPP :: (Ord b) => PointProcess a b -> ([b], [Int]) +sortPP (PointProcess _ vs _) = (vsSorted, isSorted) where vsIsSorted = sortListWithIndices vs vsSorted = map fst vsIsSorted @@ -229,7 +246,7 @@ otherwise = treeOrigin where - (vsSorted, isSorted) = sort pp + (vsSorted, isSorted) = sortPP pp !lvs = S.fromList [Node (Length 0) p [] | p <- ps] !heights = S.replicate (length ps) 0 !treeRoot = toReconstructedTree' isSorted vsSorted l lvs heights diff --git a/test/ELynx/Data/Tree/BipartitionSpec.hs b/test/ELynx/Data/Tree/BipartitionSpec.hs --- a/test/ELynx/Data/Tree/BipartitionSpec.hs +++ b/test/ELynx/Data/Tree/BipartitionSpec.hs @@ -15,7 +15,7 @@ ) where -import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Char8 as BS import Data.Map (Map) import qualified Data.Map as M import Data.Set (Set) @@ -25,16 +25,16 @@ import ELynx.Tools import Test.Hspec -sfrom :: [ByteString] -> S.Set ByteString +sfrom :: [BS.ByteString] -> S.Set BS.ByteString sfrom = S.fromList treeFileSimple :: FilePath treeFileSimple = "data/TreeDist.trees" -getSimpleTrees :: IO (Forest Phylo ByteString) +getSimpleTrees :: IO (Forest Phylo BS.ByteString) getSimpleTrees = parseFileWith (someNewick Standard) treeFileSimple -bipartitionToBranchAnswer :: Map (Bipartition ByteString) Length +bipartitionToBranchAnswer :: Map (Bipartition BS.ByteString) Length bipartitionToBranchAnswer = M.fromList [ (bpUnsafe (sfrom ["B"]) (sfrom ["A", "C", "D", "E"]), 0.3), @@ -46,7 +46,7 @@ (bpUnsafe (sfrom ["E"]) (sfrom ["A", "B", "C", "D"]), 0.8) ] -bipartitionsFirstTree :: Set (Bipartition ByteString) +bipartitionsFirstTree :: Set (Bipartition BS.ByteString) bipartitionsFirstTree = S.fromList [ bpUnsafe (sfrom ["B"]) (sfrom ["A", "C", "D", "E"]), @@ -58,7 +58,7 @@ bpUnsafe (sfrom ["E"]) (sfrom ["A", "B", "C", "D"]) ] -bipartitionsSecondTree :: Set (Bipartition ByteString) +bipartitionsSecondTree :: Set (Bipartition BS.ByteString) bipartitionsSecondTree = S.fromList [ bpUnsafe (sfrom ["B"]) (sfrom ["A", "C", "D", "E"]), diff --git a/test/ELynx/Data/Tree/DistanceSpec.hs b/test/ELynx/Data/Tree/DistanceSpec.hs --- a/test/ELynx/Data/Tree/DistanceSpec.hs +++ b/test/ELynx/Data/Tree/DistanceSpec.hs @@ -16,13 +16,10 @@ ) where --- import Data.Bifunctor -import Data.ByteString.Lazy.Char8 (ByteString) +import qualified Data.ByteString.Char8 as BS import ELynx.Data.Tree --- import qualified Data.Set as S import ELynx.Data.Tree.Arbitrary () import ELynx.Import.Tree.Newick --- import ELynx.Export.Tree.Newick import ELynx.Tools import Test.Hspec import Test.QuickCheck @@ -30,13 +27,13 @@ treeFileSimple :: FilePath treeFileSimple = "data/TreeDist.trees" -getSimpleTrees :: IO (Forest Phylo ByteString) +getSimpleTrees :: IO (Forest Phylo BS.ByteString) getSimpleTrees = parseFileWith (someNewick Standard) treeFileSimple treeFileMany :: FilePath treeFileMany = "data/Many.trees" -getManyTrees :: IO (Forest Phylo ByteString) +getManyTrees :: IO (Forest Phylo BS.ByteString) getManyTrees = parseFileWith (someNewick Standard) treeFileMany -- I used treedist from Phylip to get the correct results. @@ -184,20 +181,20 @@ Node () ' ' [Node () 'B' [], Node () ' ' [Node () 'D' [], Node () 'E' []]] ] -incSplitTree1a :: Tree Phylo ByteString -incSplitTree1a = parseByteStringWith "" (oneNewick IqTree) "((a,b)0.7,(c,d));" +incSplitTree1a :: Tree Phylo BS.ByteString +incSplitTree1a = parseByteStringWith (oneNewick IqTree) "((a,b)0.7,(c,d));" -incSplitTree1b :: Tree Phylo ByteString -incSplitTree1b = parseByteStringWith "" (oneNewick IqTree) "((a,b)0.7,c,d);" +incSplitTree1b :: Tree Phylo BS.ByteString +incSplitTree1b = parseByteStringWith (oneNewick IqTree) "((a,b)0.7,c,d);" -incSplitTree2 :: Tree Phylo ByteString -incSplitTree2 = parseByteStringWith "" (oneNewick IqTree) "((a,c),(b,d));" +incSplitTree2 :: Tree Phylo BS.ByteString +incSplitTree2 = parseByteStringWith (oneNewick IqTree) "((a,c),(b,d));" -incSplitTree3 :: Tree Phylo ByteString -incSplitTree3 = parseByteStringWith "" (oneNewick IqTree) "(((a,b)0.7,c),(d,e));" +incSplitTree3 :: Tree Phylo BS.ByteString +incSplitTree3 = parseByteStringWith (oneNewick IqTree) "(((a,b)0.7,c),(d,e));" -incSplitTree4 :: Tree Phylo ByteString -incSplitTree4 = parseByteStringWith "" (oneNewick IqTree) "(((a,c),b),(d,e));" +incSplitTree4 :: Tree Phylo BS.ByteString +incSplitTree4 = parseByteStringWith (oneNewick IqTree) "(((a,c),b),(d,e));" -- Compute distances between adjacent pairs of a list of input trees. Use given -- distance measure. diff --git a/test/ELynx/Data/Tree/PhylogenySpec.hs b/test/ELynx/Data/Tree/PhylogenySpec.hs --- a/test/ELynx/Data/Tree/PhylogenySpec.hs +++ b/test/ELynx/Data/Tree/PhylogenySpec.hs @@ -17,14 +17,10 @@ ) where --- import Data.Bifunctor --- import Data.ByteString.Lazy.Char8 (ByteString) import Data.Either import qualified Data.Set as S import ELynx.Data.Tree import ELynx.Data.Tree.Arbitrary () --- import ELynx.Import.Tree.Newick --- import ELynx.Tools import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck hiding (labels) diff --git a/test/ELynx/Data/Tree/RootedSpec.hs b/test/ELynx/Data/Tree/RootedSpec.hs --- a/test/ELynx/Data/Tree/RootedSpec.hs +++ b/test/ELynx/Data/Tree/RootedSpec.hs @@ -16,8 +16,8 @@ ) where -import Data.ByteString.Lazy.Char8 (ByteString) -import qualified Data.ByteString.Lazy.Char8 as L +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy.Char8 as BL import Data.Maybe import ELynx.Data.Tree import ELynx.Import.Tree.Newick @@ -36,16 +36,14 @@ smallSubTreePruned :: Tree () Int smallSubTreePruned = node 1 -sampleTreeBS :: ByteString -sampleTreeBS = - L.pack - "(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);" +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 ByteString -largeTree = parseByteStringWith "Sample newick byte string" (newick Standard) sampleTreeBS +largeTree :: Tree Phylo BS.ByteString +largeTree = parseByteStringWith (newick Standard) sampleTreeBS -subSampleLargeTree :: Tree Phylo ByteString -subSampleLargeTree = fromJust $ dropLeavesWith ((/= 'P') . L.head) largeTree +subSampleLargeTree :: Tree Phylo BS.ByteString +subSampleLargeTree = fromJust $ dropLeavesWith ((/= 'P') . BS.head) largeTree spec :: Spec spec = do diff --git a/test/ELynx/Export/Tree/NewickSpec.hs b/test/ELynx/Export/Tree/NewickSpec.hs --- a/test/ELynx/Export/Tree/NewickSpec.hs +++ b/test/ELynx/Export/Tree/NewickSpec.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + -- | -- Module : ELynx.Export.Tree.NewickSpec -- Copyright : (c) Dominik Schrempf 2020 @@ -14,8 +16,8 @@ where import Data.Bifunctor -import Data.ByteString.Lazy.Char8 (ByteString) -import qualified Data.ByteString.Lazy.Char8 as L +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy.Char8 as BL import ELynx.Data.Tree import ELynx.Data.Tree.Arbitrary () import ELynx.Export.Tree.Newick @@ -24,29 +26,26 @@ import Test.Hspec import Test.QuickCheck hiding (label) -samplePhyloByteStringTree :: Tree Phylo ByteString -samplePhyloByteStringTree = parseByteStringWith "Sample newick byte string" (newick Standard) sampleNewickByteString1 +samplePhyloByteStringTree :: Tree Phylo BS.ByteString +samplePhyloByteStringTree = parseByteStringWith (newick Standard) sampleNewickByteString1 -sampleNewickByteString1 :: ByteString -sampleNewickByteString1 = - L.pack - "(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);" +sampleNewickByteString1 :: BL.ByteString +sampleNewickByteString1 = "(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);" prop_invariant :: Tree Phylo Int -> Bool prop_invariant t = - parseByteStringWith "Sample newick byte string" (newick Standard) (toNewick t) + parseByteStringWith (newick Standard) (toNewick t) == -- 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 getName t + second (BL.toStrict . getName) t spec :: Spec spec = describe "parseByteStringWith newick $ toNewickPhyloByteString" $ do it "should be an invariant for a sample tree" $ do let bs = toNewick samplePhyloByteStringTree parseByteStringWith - "Newick string converted from tree object" (newick Standard) bs `shouldBe` samplePhyloByteStringTree diff --git a/test/ELynx/Export/Tree/NexusSpec.hs b/test/ELynx/Export/Tree/NexusSpec.hs --- a/test/ELynx/Export/Tree/NexusSpec.hs +++ b/test/ELynx/Export/Tree/NexusSpec.hs @@ -16,7 +16,7 @@ ) where -import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Char8 as BS import ELynx.Data.Tree import ELynx.Export.Tree.Nexus import ELynx.Import.Tree.Newick (NewickFormat (..)) @@ -24,7 +24,7 @@ import ELynx.Tools import Test.Hspec -tree :: Tree Phylo ByteString +tree :: Tree Phylo BS.ByteString tree = Node (Phylo Nothing Nothing) @@ -42,5 +42,5 @@ spec = describe "toNexusTrees" $ it "exports a nexus file with a TREES block" $ do - let ts = parseByteStringWith "NexusTrees" (nexusTrees Standard) (toNexusTrees [("tree1", tree)]) + let ts = parseByteStringWith (nexusTrees Standard) (toNexusTrees [("tree1", tree)]) head ts `shouldBe` ("tree1", tree) diff --git a/test/ELynx/Import/Tree/NewickSpec.hs b/test/ELynx/Import/Tree/NewickSpec.hs --- a/test/ELynx/Import/Tree/NewickSpec.hs +++ b/test/ELynx/Import/Tree/NewickSpec.hs @@ -15,14 +15,13 @@ ) where -import Data.ByteString.Lazy.Char8 (ByteString) -import qualified Data.ByteString.Lazy.Char8 as L +import Data.Attoparsec.ByteString.Char8 +import qualified Data.ByteString.Char8 as BS +import Data.Either import ELynx.Data.Tree import ELynx.Import.Tree.Newick import ELynx.Tools import Test.Hspec -import Test.Hspec.Megaparsec -import Text.Megaparsec -- sampleLabelByteString :: ByteString -- sampleLabelByteString = "name:0.3" @@ -48,20 +47,17 @@ -- ] -- ] -sampleNewickByteString1 :: ByteString -sampleNewickByteString1 = - L.pack - "(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);" +sampleNewickByteString1 :: BS.ByteString +sampleNewickByteString1 = "(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);" -sampleNewickByteString2 :: ByteString +sampleNewickByteString2 :: BS.ByteString sampleNewickByteString2 = - L.pack - "(Caenorhabd:0.0176707431,C0briggsae:0.0142817073,(Ancylostom:0.0711440844,(Pristionch:0.1301309005,((Brugia_mal:0.0757534325,Ascaris0su:0.0482660407)1:0.0563924634,(((Meloidogyn:0.1239621893,Heteroderi:0.0987968800)1:0.1136879428,Strongyloi:0.2483437292)1:0.0252467381,(Trichoceph:0.2985037612,((((((Coleoptera:0.0907850846,(Apis0melli:0.0754058285,Hemiptera0:0.1675359618)0.93:0.0085703192)1:0.0146980945,(Siphonapte:0.0556805916,Bombyx0mor:0.0968983509)1:0.0127867903)1:0.0167360185,((Drosophila:0.0492149086,Glossina0m:0.0534390467)1:0.0583462602,Anopheles0:0.0968919941)1:0.0431343553)1:0.0535616453,Crustacea0:0.2247268999)1:0.0252755187,Chelicerat:0.1537491558)1:0.0212497286,((Echinoderm:0.1803896615,(Cephalocho:0.1492264574,(Urochordat:0.2194747834,(Mammalia00:0.0393008407,Actinopter:0.0491700096):0.0858550024)1:0.0157515969)1:0.0132516777)1:0.0203423736,((((((((Neurospora:0.0721607581,Magnaporth:0.0814182810)1:0.0198940548,Gibberella:0.0858192964)1:0.0533872590,Eurotiomyc:0.1058840539)1:0.1266302603,(Candida0al:0.1349957509,Saccharomy:0.1553464572)1:0.1791344287)1:0.0529664967,Schizosacc:0.2550087905)1:0.0723650615,(Ustilago0m:0.2031812772,(Homobasidi:0.1473391802,Cryptococc:0.2070743149)1:0.0347868586)1:0.0790327507)1:0.0727415175,Glomales00:0.1779430068)1:0.0169066667,Chytridiom:0.3028920870)1:0.3311420273)1:0.0278566156)1:0.1049569161)1:0.1366217350)1:0.0171168289)1:0.0345725378)1:0.0542036935)1:0.0879337167)1;" + "(Caenorhabd:0.0176707431,C0briggsae:0.0142817073,(Ancylostom:0.0711440844,(Pristionch:0.1301309005,((Brugia_mal:0.0757534325,Ascaris0su:0.0482660407)1:0.0563924634,(((Meloidogyn:0.1239621893,Heteroderi:0.0987968800)1:0.1136879428,Strongyloi:0.2483437292)1:0.0252467381,(Trichoceph:0.2985037612,((((((Coleoptera:0.0907850846,(Apis0melli:0.0754058285,Hemiptera0:0.1675359618)0.93:0.0085703192)1:0.0146980945,(Siphonapte:0.0556805916,Bombyx0mor:0.0968983509)1:0.0127867903)1:0.0167360185,((Drosophila:0.0492149086,Glossina0m:0.0534390467)1:0.0583462602,Anopheles0:0.0968919941)1:0.0431343553)1:0.0535616453,Crustacea0:0.2247268999)1:0.0252755187,Chelicerat:0.1537491558)1:0.0212497286,((Echinoderm:0.1803896615,(Cephalocho:0.1492264574,(Urochordat:0.2194747834,(Mammalia00:0.0393008407,Actinopter:0.0491700096):0.0858550024)1:0.0157515969)1:0.0132516777)1:0.0203423736,((((((((Neurospora:0.0721607581,Magnaporth:0.0814182810)1:0.0198940548,Gibberella:0.0858192964)1:0.0533872590,Eurotiomyc:0.1058840539)1:0.1266302603,(Candida0al:0.1349957509,Saccharomy:0.1553464572)1:0.1791344287)1:0.0529664967,Schizosacc:0.2550087905)1:0.0723650615,(Ustilago0m:0.2031812772,(Homobasidi:0.1473391802,Cryptococc:0.2070743149)1:0.0347868586)1:0.0790327507)1:0.0727415175,Glomales00:0.1779430068)1:0.0169066667,Chytridiom:0.3028920870)1:0.3311420273)1:0.0278566156)1:0.1049569161)1:0.1366217350)1:0.0171168289)1:0.0345725378)1:0.0542036935)1:0.0879337167)1;" -sampleNewickEmptyByteString :: ByteString -sampleNewickEmptyByteString = L.pack "(,(,,),);" +sampleNewickEmptyByteString :: BS.ByteString +sampleNewickEmptyByteString = "(,(,,),);" -sampleNewickEmpty :: Tree Phylo ByteString +sampleNewickEmpty :: Tree Phylo BS.ByteString sampleNewickEmpty = Node noPL @@ -77,9 +73,8 @@ Node noPL "" [] ] -sampleTreeNewickRevbayes :: ByteString -sampleTreeNewickRevbayes = - L.pack "[&R](l[IDL]:0.3[KEYVALPAIRS],r[IDR]:0.4[KEYVALPARIS])[ID]:0.3;" +sampleTreeNewickRevbayes :: BS.ByteString +sampleTreeNewickRevbayes = "[&R](l[IDL]:0.3[KEYVALPAIRS],r[IDR]:0.4[KEYVALPARIS])[ID]:0.3;" sampleNewickRevBayesFile :: String sampleNewickRevBayesFile = "data/NewickRevBayes.tree" @@ -104,7 +99,7 @@ -- parse name "" "aName bla" -- `shouldParse` "aName" - -- it "allows empty names" $ parse name "" "" `shouldParse` L.pack "" + -- it "allows empty names" $ parse name "" "" `shouldParse` BL.pack "" -- describe "node" $ do -- it "parses a tree node" $ @@ -127,13 +122,13 @@ describe "newick" $ do it "parses newick trees" $ do - parse (newick Standard) "" `shouldSucceedOn` sampleNewickByteString1 - parse (newick Standard) "" `shouldSucceedOn` sampleNewickByteString2 + parseOnly (newick Standard) sampleNewickByteString1 `shouldSatisfy` isRight + parseOnly (newick Standard) sampleNewickByteString2 `shouldSatisfy` isRight it "parses a weird newick tree without node labels nor branch lengths" $ - parse (newick Standard) "" sampleNewickEmptyByteString `shouldParse` sampleNewickEmpty + parseOnly (newick Standard) sampleNewickEmptyByteString `shouldBe` Right sampleNewickEmpty describe "newickRevBayes" $ it "parses newick trees in RevBayes format" $ do - parse (newick RevBayes) "" `shouldSucceedOn` sampleTreeNewickRevbayes + parseOnly (newick RevBayes) sampleTreeNewickRevbayes `shouldSatisfy` isRight t2 <- parseFileWith (newick RevBayes) sampleNewickRevBayesFile length (leaves t2) `shouldBe` 102 diff --git a/test/ELynx/Import/Tree/NexusSpec.hs b/test/ELynx/Import/Tree/NexusSpec.hs --- a/test/ELynx/Import/Tree/NexusSpec.hs +++ b/test/ELynx/Import/Tree/NexusSpec.hs @@ -16,7 +16,7 @@ ) where -import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Char8 as BS import ELynx.Data.Tree import ELynx.Import.Tree.Newick (NewickFormat (..)) import ELynx.Import.Tree.Nexus @@ -29,7 +29,7 @@ noPL :: Phylo noPL = Phylo Nothing Nothing -res :: Tree Phylo ByteString +res :: Tree Phylo BS.ByteString res = Node noPL