packages feed

tlynx 0.4.0 → 0.4.1

raw patch · 11 files changed

+303/−249 lines, 11 files

Files

ChangeLog.md view
@@ -5,6 +5,20 @@ ## Unreleased changes  +## Version 0.4.1++-   Improve `TimeSpec` (Point process).+-   Parallel evaluation strategies.+-   Change names of some functions involving partitions. For example, `mp` was+    renamed to `pt`.+-   Improve documentation for (bi)partitions.+-   Bugfix `tlynx compare`; do not throw error when branch support values are not+    set.+-   Add `no-elynx-file` option.+-   Also parse Nexus files with `tlynx` commands.+-   Bugfix `subSample`; the sub sample was reversed.++ ## Version 0.4.0  -   Major refactor of `elynx-tree`. All required function can now conveniently
README.md view
@@ -2,7 +2,7 @@  # The ELynx Suite -Version: 0.4.0.+Version: 0.4.1. Reproducible evolution made easy.  <p align="center"><img src="https://travis-ci.org/dschrempf/elynx.svg?branch=master"/></p>@@ -90,12 +90,12 @@      slynx --help | head -n -16 -    ELynx Suite version 0.4.0.+    ELynx Suite version 0.4.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2020, at 13:37 pm, UTC.+    Compiled on October 16, 2020, at 12:46 pm, UTC.          Usage: slynx [-v|--verbosity VALUE] [-o|--output-file-basename NAME] -                 [-f|--force] COMMAND+                 [-f|--force] [--no-elynx-file] COMMAND       Analyze, and simulate multi sequence alignments.          Available options:@@ -107,6 +107,7 @@                                Specify base name of output file       -f,--force               Ignore previous analysis and overwrite existing                                output files.+      --no-elynx-file          Do not write files for needed for reproducibility.          Available commands:       concatenate              Concatenate sequences found in input files.@@ -136,9 +137,9 @@      slynx concatenate --help -    ELynx Suite version 0.4.0.+    ELynx Suite version 0.4.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2020, at 13:37 pm, UTC.+    Compiled on October 16, 2020, at 12:46 pm, UTC.          Usage: slynx concatenate (-a|--alphabet NAME) INPUT-FILE       Concatenate sequences found in input files.@@ -157,9 +158,9 @@      slynx examine --help -    ELynx Suite version 0.4.0.+    ELynx Suite version 0.4.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2020, at 13:37 pm, UTC.+    Compiled on October 16, 2020, at 12:46 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 +180,9 @@      slynx filter-rows --help -    ELynx Suite version 0.4.0.+    ELynx Suite version 0.4.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2020, at 13:37 pm, UTC.+    Compiled on October 16, 2020, at 12:46 pm, UTC.          Usage: slynx filter-rows (-a|--alphabet NAME) INPUT-FILE [--longer-than LENGTH]                               [--shorter-than LENGTH] [--standard-characters]@@ -202,9 +203,9 @@      slynx filter-columns --help -    ELynx Suite version 0.4.0.+    ELynx Suite version 0.4.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2020, at 13:37 pm, UTC.+    Compiled on October 16, 2020, at 12:46 pm, UTC.          Usage: slynx filter-columns (-a|--alphabet NAME) INPUT-FILE                                  [--standard-chars DOUBLE]@@ -226,9 +227,9 @@      slynx simulate --help -    ELynx Suite version 0.4.0.+    ELynx Suite version 0.4.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2020, at 13:37 pm, UTC.+    Compiled on October 16, 2020, at 12:46 pm, UTC.          Usage: slynx simulate (-t|--tree-file Name) [-s|--substitution-model MODEL]                            [-m|--mixture-model MODEL] [-e|--edm-file NAME] @@ -305,9 +306,9 @@      slynx sub-sample --help -    ELynx Suite version 0.4.0.+    ELynx Suite version 0.4.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2020, at 13:37 pm, UTC.+    Compiled on October 16, 2020, at 12:46 pm, UTC.          Usage: slynx sub-sample (-a|--alphabet NAME) INPUT-FILE                             (-n|--number-of-sites INT)@@ -335,9 +336,9 @@      slynx translate --help -    ELynx Suite version 0.4.0.+    ELynx Suite version 0.4.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2020, at 13:37 pm, UTC.+    Compiled on October 16, 2020, at 12:46 pm, UTC.          Usage: slynx translate (-a|--alphabet NAME) INPUT-FILE (-r|--reading-frame INT)                            (-u|--universal-code CODE)@@ -360,12 +361,12 @@      tlynx --help | head -n -16 -    ELynx Suite version 0.4.0.+    ELynx Suite version 0.4.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2020, at 13:37 pm, UTC.+    Compiled on October 16, 2020, at 12:46 pm, UTC.          Usage: tlynx [-v|--verbosity VALUE] [-o|--output-file-basename NAME] -                 [-f|--force] COMMAND+                 [-f|--force] [--no-elynx-file] COMMAND       Compare, examine, and simulate phylogenetic trees.          Available options:@@ -377,6 +378,7 @@                                Specify base name of output file       -f,--force               Ignore previous analysis and overwrite existing                                output files.+      --no-elynx-file          Do not write files for needed for reproducibility.          Available commands:       compare                  Compare two phylogenetic trees (compute distances and branch-wise differences).@@ -390,6 +392,7 @@     Available tree file formats:       - Newick Standard: Branch support values are stored in square brackets after branch lengths.       - Newick IqTree:   Branch support values are stored as node names after the closing bracket of forests.+      - Newick 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.   ## Compare@@ -398,9 +401,9 @@      tlynx compare --help -    ELynx Suite version 0.4.0.+    ELynx Suite version 0.4.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2020, at 13:37 pm, UTC.+    Compiled on October 16, 2020, at 12:46 pm, UTC.          Usage: tlynx compare [-n|--normalize] [-b|--bipartitions] [-t|--intersect]                           [-f|--newick-format FORMAT] NAMES@@ -427,9 +430,9 @@      tlynx examine --help -    ELynx Suite version 0.4.0.+    ELynx Suite version 0.4.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2020, at 13:37 pm, UTC.+    Compiled on October 16, 2020, at 12:46 pm, UTC.          Usage: tlynx examine INPUT-FILE [-f|--newick-format FORMAT]       Compute summary statistics of phylogenetic trees.@@ -451,9 +454,9 @@      tlynx simulate --help -    ELynx Suite version 0.4.0.+    ELynx Suite version 0.4.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2020, at 13:37 pm, UTC.+    Compiled on October 16, 2020, at 12:46 pm, UTC.          Usage: tlynx simulate (-t|--nTrees INT) (-n|--nLeaves INT) PROCESS                            [-u|--sub-sample DOUBLE] [-s|--summary-statistics] @@ -488,9 +491,9 @@      elynx --help | head -n -16 -    ELynx Suite version 0.4.0.+    ELynx Suite version 0.4.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2020, at 13:37 pm, UTC.+    Compiled on October 16, 2020, at 12:46 pm, UTC.          Usage: elynx COMMAND       Validate and redo past ELynx analyses
src/TLynx/Compare/Compare.hs view
@@ -29,51 +29,48 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as E import qualified Data.Text.IO as T-import ELynx.Tree import ELynx.Tools   ( Arguments (..),     ELynx,     GlobalArguments (..),     outHandle,-    parseFileWith,   )+import ELynx.Tree import Graphics.Gnuplot.Simple import System.IO import TLynx.Compare.Options+import TLynx.Parsers import Text.Printf  treesOneFile ::   FilePath ->   ELynx     CompareArguments-    (Tree PhyloExplicit BS.ByteString, Tree PhyloExplicit BS.ByteString)+    (Tree Phylo BS.ByteString, Tree Phylo BS.ByteString) treesOneFile tf = do   nwF <- argsNewickFormat . local <$> ask   $(logInfo) $ T.pack $ "Parse file '" ++ tf ++ "'."-  ts <- liftIO $ parseFileWith (someNewick nwF) tf+  ts <- liftIO $ parseTrees nwF tf   let n = length ts   case compare n 2 of     LT -> error "Not enough trees in file."     GT -> error "Too many trees in file."     EQ ->-      return-        ( either error id $ toExplicitTree $ head ts,-          either error id $ toExplicitTree $ head . tail $ ts-        )+      return (head ts, head . tail $ ts)  treesTwoFiles ::   FilePath ->   FilePath ->   ELynx     CompareArguments-    (Tree PhyloExplicit BS.ByteString, Tree PhyloExplicit BS.ByteString)+    (Tree Phylo BS.ByteString, Tree Phylo BS.ByteString) treesTwoFiles tf1 tf2 = do   nwF <- argsNewickFormat . local <$> ask   $(logInfo) $ T.pack $ "Parse first tree file '" ++ tf1 ++ "'."-  t1 <- liftIO $ parseFileWith (oneNewick nwF) tf1+  t1 <- liftIO $ parseTree nwF tf1   $(logInfo) $ T.pack $ "Parse second tree file '" ++ tf2 ++ "'."-  t2 <- liftIO $ parseFileWith (oneNewick nwF) tf2-  return (either error id $ toExplicitTree t1, either error id $ toExplicitTree t2)+  t2 <- liftIO $ parseTree nwF tf2+  return (t1, t2)  -- | More detailed comparison of two trees. compareCmd :: ELynx CompareArguments ()@@ -91,9 +88,9 @@       error         "Need two input files with one tree each or one input file with two trees."   liftIO $ hPutStrLn outH "Tree 1:"-  liftIO $ BL.hPutStrLn outH $ toNewick $ toPhyloTree tr1+  liftIO $ BL.hPutStrLn outH $ toNewick tr1   liftIO $ hPutStrLn outH "Tree 2:"-  liftIO $ BL.hPutStrLn outH $ toNewick $ toPhyloTree tr2+  liftIO $ BL.hPutStrLn outH $ toNewick tr2   liftIO $ hPutStrLn outH ""   -- Intersect trees.   (t1, t2) <-@@ -101,23 +98,24 @@       then do         let [x, y] = either error id $ intersect [tr1, tr2]         liftIO $ hPutStrLn outH "Intersected trees are:"-        liftIO $ BL.hPutStrLn outH $ toNewick $ toPhyloTree x-        liftIO $ BL.hPutStrLn outH $ toNewick $ toPhyloTree y+        liftIO $ BL.hPutStrLn outH $ toNewick x+        liftIO $ BL.hPutStrLn outH $ toNewick y         return (x, y)       else return (tr1, tr2)-  -- Check input (moved to library functions).-  -- let lvs1  = leaves t1-  --     lvs2  = leaves t2-  --     lfns1 = map getName lvs1-  --     lfns2 = map getName lvs2-  --     s1    = S.fromList lfns1-  --     s2    = S.fromList lfns2-  -- if s1 == s2-  --   then liftIO $ hPutStrLn outH "Trees have the same set of leaf names."-  --   else error "Trees do not have the same set of leaf names."-  -- liftIO $ hPutStrLn outH ""    -- Distances.+  analyzeDistance outH t1 t2++  -- Bipartitions.+  when (argsBipartitions l) $ analyzeBipartitions outH t1 t2+  liftIO $ hClose outH++analyzeDistance ::+  Handle ->+  Tree Phylo BS.ByteString ->+  Tree Phylo BS.ByteString ->+  ELynx CompareArguments ()+analyzeDistance outH t1 t2 = do   let formatD str val = T.justifyLeft 25 ' ' str <> "  " <> val   liftIO $ hPutStrLn outH "Distances."   liftIO $@@ -125,114 +123,127 @@       formatD         "Symmetric"         (T.pack $ show $ symmetric t1 t2)-  liftIO $-    T.hPutStrLn outH $-      formatD-        "Branch score"-        (T.pack $ show $ branchScore t1 t2)-  let t1' = normalizeBranchSupport t1-      t2' = normalizeBranchSupport t2-  $(logDebug) "Trees with normalized branch support values:"-  $(logDebug) $ E.decodeUtf8 $ BL.toStrict $ toNewick $ toPhyloTree t1'-  $(logDebug) $ E.decodeUtf8 $ BL.toStrict $ toNewick $ toPhyloTree t2'-  liftIO $-    T.hPutStrLn outH $-      formatD-        "Incompatible split"-        (T.pack $ show $ incompatibleSplits t1' t2')-  liftIO $-    T.hPutStrLn outH $-      formatD-        "Incompatible split (0.10)"-        (T.pack $ show $ incompatibleSplits (collapse 0.1 t1') (collapse 0.1 t2'))-  liftIO $-    T.hPutStrLn outH $-      formatD-        "Incompatible split (0.50)"-        (T.pack $ show $ incompatibleSplits (collapse 0.5 t1') (collapse 0.5 t2'))-  -- liftIO $ T.hPutStrLn outH $ formatD "Incompatible split (0.60)"-  --   (T.pack $ show $ incompatibleSplits (collapse 0.6 t1') (collapse 0.6 t2'))-  -- liftIO $ T.hPutStrLn outH $ formatD "Incompatible split (0.70)"-  --   (T.pack $ show $ incompatibleSplits (collapse 0.7 t1') (collapse 0.7 t2'))-  liftIO $-    T.hPutStrLn outH $-      formatD-        "Incompatible split (0.80)"-        (T.pack $ show $ incompatibleSplits (collapse 0.8 t1') (collapse 0.8 t2'))-  liftIO $-    T.hPutStrLn outH $-      formatD-        "Incompatible split (0.90)"-        (T.pack $ show $ incompatibleSplits (collapse 0.9 t1') (collapse 0.9 t2'))-  -- liftIO $ T.hPutStrLn outH $ formatD "Incompatible split (1.01)"-  --   (T.pack $ show $ incompatibleSplits (collapse 1.01 t1') (collapse 1.01 t2'))-  -- liftIO $ BL.hPutStrLn outH $ toNewick (collapse 1.01 t1')+  case (phyloToLengthTree t1, phyloToLengthTree t2) of+    (Right t1', Right t2') -> do+      liftIO $+        T.hPutStrLn outH $+          formatD+            "Branch score"+            (T.pack $ show $ branchScore t1' t2')+    _ -> do+      $(logInfo) "Some branches do not have length values."+      $(logInfo) "Distances involving length cannot be calculated."+  case (toExplicitTree t1, toExplicitTree t2) of+    (Right t1', Right t2') -> do+      let t1n = normalizeBranchSupport t1'+          t2n = normalizeBranchSupport t2'+      $(logDebug) "Trees with normalized branch support values:"+      $(logDebug) $ E.decodeUtf8 $ BL.toStrict $ toNewick $ toPhyloTree t1n+      $(logDebug) $ E.decodeUtf8 $ BL.toStrict $ toNewick $ toPhyloTree t2n+      liftIO $+        T.hPutStrLn outH $+          formatD+            "Incompatible split"+            (T.pack $ show $ incompatibleSplits t1n t2n)+      liftIO $+        T.hPutStrLn outH $+          formatD+            "Incompatible split (0.10)"+            (T.pack $ show $ incompatibleSplits (collapse 0.1 t1n) (collapse 0.1 t2n))+      liftIO $+        T.hPutStrLn outH $+          formatD+            "Incompatible split (0.50)"+            (T.pack $ show $ incompatibleSplits (collapse 0.5 t1n) (collapse 0.5 t2n))+      -- liftIO $ T.hPutStrLn outH $ formatD "Incompatible split (0.60)"+      --   (T.pack $ show $ incompatibleSplits (collapse 0.6 t1n) (collapse 0.6 t2n))+      -- liftIO $ T.hPutStrLn outH $ formatD "Incompatible split (0.70)"+      --   (T.pack $ show $ incompatibleSplits (collapse 0.7 t1n) (collapse 0.7 t2n))+      liftIO $+        T.hPutStrLn outH $+          formatD+            "Incompatible split (0.80)"+            (T.pack $ show $ incompatibleSplits (collapse 0.8 t1n) (collapse 0.8 t2n))+      liftIO $+        T.hPutStrLn outH $+          formatD+            "Incompatible split (0.90)"+            (T.pack $ show $ incompatibleSplits (collapse 0.9 t1n) (collapse 0.9 t2n))+    -- liftIO $ T.hPutStrLn outH $ formatD "Incompatible split (1.01)"+    --   (T.pack $ show $ incompatibleSplits (collapse 1.01 t1n) (collapse 1.01 t2n))+    -- liftIO $ BL.hPutStrLn outH $ toNewick (collapse 1.01 t1n)+    _ -> do+      $(logInfo) "Some branches do not have support values."+      $(logInfo) "Distances involving branch support cannot be calculated." -  -- Bipartitions.-  when-    (argsBipartitions l)-    ( do-        let bp1 = either error id $ bipartitions t1-            bp2 = either error id $ bipartitions t2-            bp1Only = bp1 S.\\ bp2-            bp2Only = bp2 S.\\ bp1-        unless-          (S.null bp1Only)-          ( do-              liftIO $ hPutStrLn outH ""-              liftIO $-                hPutStrLn outH "Bipartitions in Tree 1 that are not in Tree 2."-              -- let bp1Strs = map (bphuman BL.unpack . bpmap getName) (S.toList bp1Only)-              forM_ bp1Only (liftIO . hPutStrLn outH . bpHuman)-          )-        -- let bp1Strs = map (bphuman BL.unpack) (S.toList bp1Only)-        -- liftIO $ hPutStrLn outH $ intercalate "\n" bp1Strs)-        unless-          (S.null bp2Only)-          ( do-              liftIO $ hPutStrLn outH ""-              liftIO $-                hPutStrLn outH "Bipartitions in Tree 2 that are not in Tree 1."-              forM_ bp2Only (liftIO . hPutStrLn outH . bpHuman)-          )-        -- Common bipartitions and their respective differences in branch lengths.-        liftIO $ hPutStrLn outH ""-        let bpCommon = bp1 `S.intersection` bp2-        if S.null bpCommon-          then do-            liftIO $ hPutStrLn outH "There are no common bipartitions."-            liftIO $ hPutStrLn outH "No plots have been generated."-          else do-            let bpToBrLen1 = M.map getLen $ either error id $ bipartitionToBranch t1-                bpToBrLen2 = M.map getLen $ either error id $ bipartitionToBranch t2+analyzeBipartitions ::+  Handle ->+  Tree Phylo BS.ByteString ->+  Tree Phylo BS.ByteString ->+  ELynx CompareArguments ()+analyzeBipartitions outH t1 t2 =+  case (phyloToLengthTree t1, phyloToLengthTree t2) of+    (Right t1l, Right t2l) -> do+      let bp1 = either error id $ bipartitions t1l+          bp2 = either error id $ bipartitions t2l+          bp1Only = bp1 S.\\ bp2+          bp2Only = bp2 S.\\ bp1+      unless+        (S.null bp1Only)+        ( do+            liftIO $ hPutStrLn outH ""             liftIO $-              hPutStrLn-                outH-                "Common bipartitions and their respective differences in branch lengths."-            -- Header.-            liftIO $ hPutStrLn outH header-            forM_-              bpCommon-              ( liftIO-                  . hPutStrLn outH-                  . getCommonBpStr bpToBrLen1 bpToBrLen2-              )-            -- XXX: This circumvents the extension checking, and hash creation for-            -- elynx files.-            bn <- outFileBaseName . global <$> ask-            case bn of-              Nothing ->-                $(logInfo) "No output file name provided. Do not generate plots."-              Just fn -> do-                let compareCommonBps =-                      [ (bpToBrLen1 M.! b, bpToBrLen2 M.! b)-                        | b <- S.toList bpCommon-                      ]-                liftIO $ epspdfPlot fn (plotBps compareCommonBps)-                $(logInfo)-                  "Comparison of branch lengths plot generated (EPS and PDF)"-    )-  liftIO $ hClose outH+              hPutStrLn outH "Bipartitions in Tree 1 that are not in Tree 2."+            -- let bp1Strs = map (bphuman BL.unpack . bpmap getName) (S.toList bp1Only)+            forM_ bp1Only (liftIO . hPutStrLn outH . bpHuman)+        )+      -- let bp1Strs = map (bphuman BL.unpack) (S.toList bp1Only)+      -- liftIO $ hPutStrLn outH $ intercalate "\n" bp1Strs)+      unless+        (S.null bp2Only)+        ( do+            liftIO $ hPutStrLn outH ""+            liftIO $+              hPutStrLn outH "Bipartitions in Tree 2 that are not in Tree 1."+            forM_ bp2Only (liftIO . hPutStrLn outH . bpHuman)+        )+      -- Common bipartitions and their respective differences in branch lengths.+      liftIO $ hPutStrLn outH ""+      let bpCommon = bp1 `S.intersection` bp2+      if S.null bpCommon+        then do+          liftIO $ hPutStrLn outH "There are no common bipartitions."+          liftIO $ hPutStrLn outH "No plots have been generated."+        else do+          let bpToBrLen1 = M.map getLen $ either error id $ bipartitionToBranch t1l+              bpToBrLen2 = M.map getLen $ either error id $ bipartitionToBranch t2l+          liftIO $+            hPutStrLn+              outH+              "Common bipartitions and their respective differences in branch lengths."+          -- Header.+          liftIO $ hPutStrLn outH header+          forM_+            bpCommon+            ( liftIO+                . hPutStrLn outH+                . getCommonBpStr bpToBrLen1 bpToBrLen2+            )+          -- XXX: This circumvents the extension checking, and hash creation for+          -- elynx files.+          bn <- outFileBaseName . global <$> ask+          case bn of+            Nothing ->+              $(logInfo) "No output file name provided. Do not generate plots."+            Just fn -> do+              let compareCommonBps =+                    [ (bpToBrLen1 M.! b, bpToBrLen2 M.! b)+                      | b <- S.toList bpCommon+                    ]+              liftIO $ epspdfPlot fn (plotBps compareCommonBps)+              $(logInfo)+                "Comparison of branch lengths plot generated (EPS and PDF)"+    _ -> $(logWarn) "Not all branches have a length! Can not analyze bipartitions."  header :: String header = intercalate "  " $ cols ++ ["Bipartition"]@@ -274,6 +285,9 @@              YLabel "Branch lengths, tree 2"            ]     ps1 = PlotStyle Points (DefaultStyle 1)-    m = maximum $ map fst xs ++ map snd xs+    -- m = minimum $ map fst xs ++ map snd xs+    mx = maximum $ map fst xs+    my = maximum $ map snd xs+    m = min mx my     line = [(0, 0), (m, m)]     ps2 = PlotStyle Lines (DefaultStyle 1)
src/TLynx/Connect/Connect.hs view
@@ -23,17 +23,17 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.Set as S-import ELynx.Tree import ELynx.Tools   ( Arguments (..),     ELynx,     fromBs,     outHandle,-    parseFileWith,     tShow,   )+import ELynx.Tree import System.IO import TLynx.Connect.Options+import TLynx.Parsers  -- Connect two trees with a branch in all possible ways. --@@ -85,27 +85,29 @@  compatibleAll :: (Show a, Ord a) => Tree e a -> [Constraint a] -> Bool compatibleAll t@(Node _ _ [l, r]) cs =-  all (compatible (either error id $ partition l)) (map getP cs)-    && all (compatible (either error id $ partition r)) (map getP cs)+  all (compatible partitionLeft . getP) cs+    && all (compatible partitionRight . getP) cs   where     lvs = S.fromList $ leaves t-    getP x = either error id $ mp [x, lvs S.\\ x]+    getP x = either error id $ pt [x, lvs S.\\ x]+    partitionLeft = either error id $ partition l+    partitionRight = either error id $ partition r compatibleAll _ _ = error "Tree is not bifurcating."  compatibleWith ::   (Show b, Ord b) => (a -> b) -> [Constraint a] -> Tree e a -> Bool compatibleWith f cs t = compatibleAll (fmap f t) (map (S.map f) cs) -parseTrees ::+parseTreeTuple ::   FilePath ->   FilePath ->   ELynx     ConnectArguments     (Tree Length BS.ByteString, Tree Length BS.ByteString)-parseTrees l r = do+parseTreeTuple l r = do   nwF <- nwFormat . local <$> ask-  tl <- liftIO $ parseFileWith (oneNewick nwF) l-  tr <- liftIO $ parseFileWith (oneNewick nwF) r+  tl <- liftIO $ parseTree nwF l+  tr <- liftIO $ parseTree nwF r   $(logInfo) "Tree 1:"   $(logInfo) $ fromBs $ toNewick tl   $(logInfo) "Tree 2:"@@ -114,7 +116,7 @@  connectOnly :: Handle -> FilePath -> FilePath -> ELynx ConnectArguments () connectOnly h l r = do-  (tl, tr) <- parseTrees l r+  (tl, tr) <- parseTreeTuple l r   let ts = connectTrees tl tr   $(logInfo) $ "Connected trees: " <> tShow (length ts)   liftIO $ BL.hPutStr h $ BL.unlines $ map (toNewick . measurableToPhyloTree) ts@@ -123,10 +125,10 @@   Handle -> FilePath -> FilePath -> FilePath -> ELynx ConnectArguments () connectAndFilter h c l r = do   nwF <- nwFormat . local <$> ask-  cts <- liftIO $ parseFileWith (someNewick nwF) c+  cts <- liftIO $ parseTrees nwF c   $(logInfo) "Constraints:"   $(logInfo) $ fromBs $ BL.intercalate "\n" $ map toNewick cts-  (tl, tr) <- parseTrees l r+  (tl, tr) <- parseTreeTuple l r   let ts = connectTrees tl tr       cs = map S.fromList $ concatMap multifurcatingGroups cts :: [Constraint BS.ByteString]       -- Only collect trees that are compatible with the constraints.
src/TLynx/Distance/Distance.hs view
@@ -40,11 +40,12 @@ import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT import qualified Data.Vector.Unboxed as V-import ELynx.Tree import ELynx.Tools+import ELynx.Tree import Statistics.Sample import System.IO import TLynx.Distance.Options+import TLynx.Parsers import Text.Printf  median :: Ord a => [a] -> a@@ -84,16 +85,6 @@       (j, y) <- zip is xs   ] --- -- Compute distances between adjacent pairs of a list of input trees. Use given--- -- distance measure.--- adjacent ::---   -- | Distance function.---   (a -> a -> b) ->---   -- | Input values.---   [a] ->---   [b]--- adjacent dist trs = [dist x y | (x, y) <- zip trs (tail trs)]- -- | Compute distance functions between phylogenetic trees. distance :: ELynx DistanceArguments () distance = do@@ -107,7 +98,7 @@     Nothing -> return Nothing     Just f -> do       $(logInfo) $ T.pack $ "Read master tree from file: " <> f <> "."-      t <- liftIO $ parseFileWith (oneNewick nwFormat) f+      t <- liftIO $ parseTree nwFormat f       $(logInfo) "Compute distances between all trees and master tree."       return $ Just t   let tfps = argsInFiles l@@ -115,13 +106,13 @@     [] -> error "No tree input files given."     [tf] -> do       $(logInfo) "Read trees from single file."-      ts <- liftIO $ parseFileWith (someNewick nwFormat) tf+      ts <- liftIO $ parseTrees nwFormat tf       $(logInfo) $ tShow (length ts) <> " trees found in file."       $(logInfo) "Trees are indexed with integers."       return (ts, map show [0 .. length ts - 1])     _ -> do       $(logInfo) "Read trees from files."-      ts <- liftIO $ mapM (parseFileWith (oneNewick nwFormat)) tfps+      ts <- liftIO $ mapM (parseTree nwFormat) tfps       $(logInfo) "Trees are named according to their file names."       return (ts, tfps)   when (null trees) (error "Not enough trees found in files.")@@ -145,14 +136,17 @@             ++ "."     BranchScore -> $(logInfo) "Use branch score distance."   let distanceMeasure' ::-        (Measurable e1, Measurable e2) =>-        Tree e1 BS.ByteString ->-        Tree e2 BS.ByteString ->+        Tree Phylo BS.ByteString ->+        Tree Phylo BS.ByteString ->         Double       distanceMeasure' t1 t2 = either error id $ case dist of         Symmetric -> second fromIntegral $ symmetric t1 t2-        IncompatibleSplit _ -> second fromIntegral $ incompatibleSplits t1 t2-        BranchScore -> branchScore t1 t2+        IncompatibleSplit val -> second fromIntegral $ incompatibleSplits+                                 (collapse val $ normalizeBranchSupport $ either error id $ phyloToSupportTree t1)+                                 (collapse val $ normalizeBranchSupport $ either error id $ phyloToSupportTree t2)+        BranchScore ->+          branchScore (normalizeF $ either error id $ phyloToLengthTree t1) (normalizeF $ either error id $ phyloToLengthTree t2)+        where normalizeF = if argsNormalize l then normalizeBranchLengths else id   -- Possibly intersect trees before distance calculation.   when (argsIntersect l) $     $(logInfo) "Intersect trees before calculation of distances."@@ -167,24 +161,9 @@   -- Possibly normalize trees.   when (argsNormalize l) $     $(logInfo) "Normalize trees before calculation of distances."-  let normalizeF = if argsNormalize l then normalizeBranchLengths else id-  -- Possibly collapse unsupported nodes.-  let collapseF = case dist of-        -- For the incompatible split distance we have to collapse branches with-        -- support lower than the given value. Before doing so, we normalize the-        -- branch support values.-        IncompatibleSplit val -> collapse val . normalizeBranchSupport-        _ -> id-  -- The trees can be prepared now.-  let trees' :: Forest PhyloExplicit BS.ByteString-      trees' = map (collapseF . normalizeF . either error id . toExplicitTree) trees-  $(logDebug) "The prepared trees are:"-  $(logDebug) $ LT.toStrict $ LT.decodeUtf8 $ BL.unlines $ map (toNewick . toPhyloTree) trees'   let dsTriplets = case mtree of-        Nothing -> pairwise distanceMeasure trees'-        Just pt ->-          let t = (either error id . toExplicitTree) pt-           in [(0, i, distanceMeasure t t') | (i, t') <- zip [1 ..] trees']+        Nothing -> pairwise distanceMeasure trees+        Just masterTree -> [(0, i, distanceMeasure masterTree t') | (i, t') <- zip [1 ..] trees]       ds = map (\(_, _, x) -> x) dsTriplets       dsVec = V.fromList ds   liftIO $
src/TLynx/Examine/Examine.hs view
@@ -25,13 +25,14 @@ import Data.Containers.ListUtils (nubOrd) import Data.List ((\\)) import qualified Data.Text as T-import ELynx.Tree import ELynx.Tools+import ELynx.Tree import System.IO   ( Handle,     hPutStrLn,   ) import TLynx.Examine.Options+import TLynx.Parsers import Text.Printf  pretty :: BranchLength -> String@@ -62,7 +63,7 @@ readTrees fp = do   $(logInfo) $ T.pack $ "Read tree(s) from file " <> fp <> "."   nf <- argsNewickFormat . local <$> ask-  liftIO $ parseFileWith (someNewick nf) fp+  liftIO $ parseTrees nf fp  examineTree :: Named a => Handle -> Tree Phylo a -> IO () examineTree h t = do
src/TLynx/Parsers.hs view
@@ -1,6 +1,6 @@ -- | -- Module      :  TLynx.Parsers--- Description :  Common parsers+-- Description :  Parse Newick/Nexus tree files -- Copyright   :  (c) Dominik Schrempf 2020 -- License     :  GPL-3.0-or-later --@@ -10,20 +10,58 @@ -- -- Creation date: Wed Apr 22 13:34:35 2020. module TLynx.Parsers-  ( NewickFormat,+  (+    parseTree,+    parseTrees,+    NewickFormat,     newickFormat,     newickHelp,   ) where -import Data.List (intercalate)+import qualified Data.ByteString.Char8 as BS+import Data.List+import ELynx.Tools import ELynx.Tree-  ( NewickFormat (..),-    description,-  )-import ELynx.Tools (allValues) import Options.Applicative +printError :: String -> String -> String -> IO a+printError fn new nex = do+  putStrLn $ "Error of Newick parser: " <> new <> "."+  putStrLn $ "Error of Nexus  parser: " <> nex <> "."+  error $ "Could not read tree file: " <> fn <> "."++-- | Parse a Newick tree file or a Nexus file with Newick trees.+--+-- Error if no or more than one trees are found.+-- Error if both file formats fail to parse.+parseTree :: NewickFormat -> FilePath -> IO (Tree Phylo BS.ByteString)+parseTree fmt fn = do+  parseResultNewick <- runParserOnFile (oneNewick fmt) fn+  case parseResultNewick of+    Right r -> return r+    Left eNewick -> do+      parseResultNexus <- runParserOnFile (nexusTrees fmt) fn+      case parseResultNexus of+        Right [] -> error $ "No tree found in Nexus file " <> fn <> "."+        Right [(_, t)] -> return t+        Right _ -> error $ "More than one tree found in Nexus file " <> fn <> "."+        Left eNexus -> printError fn eNewick eNexus++-- | Parse a Newick tree file or a Nexus file with Newick trees.+--+-- Error if both file formats fail to parse.+parseTrees :: NewickFormat -> FilePath -> IO (Forest Phylo BS.ByteString)+parseTrees fmt fn = do+  parseResultNewick <- runParserOnFile (someNewick fmt) fn+  case parseResultNewick of+    Right r -> return r+    Left eNewick -> do+      parseResultNexus <- runParserOnFile (nexusTrees fmt) fn+      case parseResultNexus of+        Right r -> return $ map snd r+        Left eNexus -> printError fn eNewick eNexus+ -- | Parse 'NewickFormat'. newickFormat :: Parser NewickFormat newickFormat =@@ -39,6 +77,6 @@  -- | Help for different 'NewickFormat's. newickHelp :: [String]-newickHelp = map (toListItem . description) (allValues :: [NewickFormat])+newickHelp = map (toListItem . description) (allValues :: [NewickFormat]) ++ ["- Nexus file including Newick trees"]   where     toListItem = ("- Newick " ++)
src/TLynx/Shuffle/Shuffle.hs view
@@ -26,15 +26,16 @@ import Control.Monad.Logger (logDebug, logInfo) import Control.Monad.Trans.Reader (ask) import qualified Data.ByteString.Lazy.Char8 as BL+import ELynx.Tools import ELynx.Tree import ELynx.Tree.Simulate.PointProcess   ( PointProcess (PointProcess),     toReconstructedTree,   )-import ELynx.Tools import System.IO (hClose) import System.Random.MWC (GenIO, initialize) import TLynx.Shuffle.Options+import TLynx.Parsers  -- | Shuffle a tree. Get all coalescent times, shuffle them. Get all leaves, -- shuffle them. Connect the shuffled leaves with the shuffled coalescent times.@@ -45,7 +46,7 @@   l <- local <$> ask   h <- outHandle "results" ".tree"   let nwF = nwFormat l-  tPhylo <- liftIO $ parseFileWith (oneNewick nwF) (inFile l)+  tPhylo <- liftIO $ parseTree nwF (inFile l)   $(logInfo) "Input tree:"   $(logInfo) $ fromBs $ toNewick tPhylo   let t = either error id $ phyloToLengthTree tPhylo
src/TLynx/Simulate/Options.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -Wno-orphans #-}  -- | -- Module      :  TLynx.Simulate.Options@@ -13,8 +15,7 @@ -- -- Creation date: Fri May  3 11:51:07 2019. module TLynx.Simulate.Options-  ( Height (..),-    Process (..),+  ( Process (..),     SimulateArguments (..),     simulateArguments,     reportSimulateArguments,@@ -22,20 +23,23 @@ where  import Data.List-import ELynx.Tools+import Data.Maybe+import ELynx.Tools hiding (Random)+import ELynx.Tree.Simulate.PointProcess (TimeSpec (..)) import Options.Applicative --- | Condition on tree height (origin or most recent common ancestor).-data Height = Origin Double | Mrca Double-  deriving (Eq, Generic)+deriving instance Eq TimeSpec -instance Show Height where+deriving instance Generic TimeSpec++instance Show TimeSpec where+  show Random = "Random"   show (Origin o) = "Condition on height of origin: " ++ show o   show (Mrca m) = "Condition on height of MRCA: " ++ show m -instance FromJSON Height+instance FromJSON TimeSpec -instance ToJSON Height+instance ToJSON TimeSpec  -- | Process to be used for simulation. data Process@@ -47,7 +51,7 @@         -- | Sampling rate.         bdRho :: Maybe Double,         -- | Condition on height?-        bdHeight :: Maybe Height+        bdHeight :: TimeSpec       }   | Coalescent   deriving (Eq, Show, Generic)@@ -57,14 +61,14 @@ instance ToJSON Process  reportProcess :: Process -> String-reportProcess (BirthDeath l m mr mh) =+reportProcess (BirthDeath l m mr ts) =   intercalate     "\n"     [ "Model: Birth and death process",       "  Birth rate: " ++ show l,       "  Death rate: " ++ show m,       "  Sampling probability: " ++ maybe "1.0" show mr,-      "  Height specification: " ++ maybe "Random" show mh+      "  Height specification: " ++ show ts     ] reportProcess Coalescent = "Model: Coalescent process" @@ -166,7 +170,7 @@       <> metavar "DOUBLE"       <> help "Sampling probability rho" -mrca :: Parser Height+mrca :: Parser TimeSpec mrca =   Mrca     <$> option@@ -176,7 +180,7 @@           <> help "Condition on height of most recent common ancestor"       ) -origin :: Parser Height+origin :: Parser TimeSpec origin =   Origin     <$> option@@ -186,8 +190,11 @@           <> help "Condition on height of origin"       ) +timeSpec :: Parser TimeSpec+timeSpec = fromMaybe Random <$> optional (mrca <|> origin)+ birthDeath :: Parser Process-birthDeath = BirthDeath <$> lambdaOpt <*> muOpt <*> optional rhoOpt <*> optional (mrca <|> origin)+birthDeath = BirthDeath <$> lambdaOpt <*> muOpt <*> optional rhoOpt <*> timeSpec  coalescent :: Parser Process coalescent = pure Coalescent
src/TLynx/Simulate/Simulate.hs view
@@ -43,10 +43,10 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT+import ELynx.Tools import ELynx.Tree import qualified ELynx.Tree.Simulate.Coalescent as CS import qualified ELynx.Tree.Simulate.PointProcess as PP-import ELynx.Tools import System.Random.MWC import TLynx.Simulate.Options @@ -62,13 +62,8 @@   gs <- liftIO $ initialize s >>= \gen -> splitGen c gen   let chunks = getChunks c nTrees   trs <- case pr of-    (BirthDeath lambda mu mRho mHeight) -> do+    (BirthDeath lambda mu mRho timeSpec) -> do       let rho = fromMaybe 1.0 mRho-          -- This is bad code, but I don't want to change the definition of 'TimeSpec'.-          timeSpec = case mHeight of-            Nothing -> Nothing-            Just (Mrca h) -> Just (h, True)-            Just (Origin h) -> Just (h, False)       case subS of         Nothing -> liftIO $ bdSimulateNTreesConcurrently nLeaves lambda mu rho timeSpec chunks gs         Just p ->@@ -116,9 +111,9 @@   IO (Forest Length Int) coalSimulateNTreesConcurrently nL chunks gs = do   trss <--      mapConcurrently-        (\(n, g) -> replicateM n $ CS.simulate nL g)-        (zip chunks gs)+    mapConcurrently+      (\(n, g) -> replicateM n $ CS.simulate nL g)+      (zip chunks gs)   return $ concat trss  bdSimulateAndSubSampleNTreesConcurrently ::
tlynx.cabal view
@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           tlynx-version:        0.4.0+version:        0.4.1 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