{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      :  SLynx.Simulate.Simulate
-- Description :  Simulate multiple sequence alignments
-- Copyright   :  (c) Dominik Schrempf 2021
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Mon Jan 28 14:12:52 2019.
module SLynx.Simulate.Simulate
  ( simulateCmd,
  )
where

import Control.Applicative ((<|>))
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader (ask)
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.List
import Data.Maybe
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
import qualified Data.Vector as V
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as U
import ELynx.Data.Alphabet.Alphabet as A
import qualified ELynx.Data.MarkovProcess.AminoAcid as MA
import ELynx.Data.MarkovProcess.GammaRateHeterogeneity
import qualified ELynx.Data.MarkovProcess.MixtureModel as MM
import qualified ELynx.Data.MarkovProcess.PhyloModel as MP
import qualified ELynx.Data.MarkovProcess.RateMatrix as MR
import qualified ELynx.Data.MarkovProcess.SubstitutionModel as MS
import qualified ELynx.Data.Sequence.Sequence as Seq hiding
  ( name,
  )
import ELynx.Export.Sequence.Fasta
import ELynx.Import.MarkovProcess.EDMModelPhylobayes
import ELynx.Import.MarkovProcess.SiteprofilesPhylobayes
import ELynx.Simulate.MarkovProcessAlongTree
import ELynx.Tools
import ELynx.Tree
import SLynx.Simulate.Options
import SLynx.Simulate.PhyloModel
import System.Random.MWC
import Text.Printf

getDistLine :: Int -> MR.StationaryDistribution -> BB.Builder
getDistLine :: Int -> StationaryDistribution -> Builder
getDistLine Int
i StationaryDistribution
d =
  Int -> Builder
BB.intDec Int
i
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char8 Char
' '
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
s
  where
    s :: Builder
s = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
BB.char8 Char
' ') ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (Double -> Builder) -> [Double] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Builder
BB.doubleDec ([Double] -> [Builder]) -> [Double] -> [Builder]
forall a b. (a -> b) -> a -> b
$ StationaryDistribution -> [Double]
forall a. Storable a => Vector a -> [a]
VS.toList StationaryDistribution
d

writeSiteDists :: [Int] -> V.Vector MR.StationaryDistribution -> ELynx SimulateArguments ()
-- writeSiteDists is ds = out "site distributions of distribution mixture model" output ".sitedists"
writeSiteDists :: [Int]
-> Vector StationaryDistribution -> ELynx SimulateArguments ()
writeSiteDists [Int]
componentIs Vector StationaryDistribution
ds = do
  Maybe FilePath
mbn <- GlobalArguments -> Maybe FilePath
outFileBaseName (GlobalArguments -> Maybe FilePath)
-> (Arguments SimulateArguments -> GlobalArguments)
-> Arguments SimulateArguments
-> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments SimulateArguments -> GlobalArguments
forall a. Arguments a -> GlobalArguments
global (Arguments SimulateArguments -> Maybe FilePath)
-> ReaderT
     (Arguments SimulateArguments)
     (LoggingT IO)
     (Arguments SimulateArguments)
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  (Arguments SimulateArguments)
  (LoggingT IO)
  (Arguments SimulateArguments)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  case Maybe FilePath
mbn of
    Maybe FilePath
Nothing -> () -> ELynx SimulateArguments ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just FilePath
bn -> IO () -> ELynx SimulateArguments ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ELynx SimulateArguments ())
-> IO () -> ELynx SimulateArguments ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
BL.writeFile (FilePath
bn FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".sitedists") ByteString
output
  where
    dsPaml :: Vector StationaryDistribution
dsPaml = (StationaryDistribution -> StationaryDistribution)
-> Vector StationaryDistribution -> Vector StationaryDistribution
forall a b. (a -> b) -> Vector a -> Vector b
V.map StationaryDistribution -> StationaryDistribution
MA.alphaToPamlVec Vector StationaryDistribution
ds
    lns :: [Builder]
lns = [Int -> StationaryDistribution -> Builder
getDistLine Int
i StationaryDistribution
d | (Int
i, Int
c) <- [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [Int]
componentIs, let d :: StationaryDistribution
d = Vector StationaryDistribution
dsPaml Vector StationaryDistribution -> Int -> StationaryDistribution
forall a. Vector a -> Int -> a
V.! Int
c]
    output :: ByteString
output = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
BB.char8 Char
'\n') [Builder]
lns

-- Simulate a 'Alignment' for a given phylogenetic model,
-- phylogenetic tree, and alignment length.
simulateAlignment ::
  (HasLength e, HasName a) =>
  MP.PhyloModel ->
  Tree e a ->
  Int ->
  GenIO ->
  ELynx SimulateArguments ()
simulateAlignment :: PhyloModel
-> Tree e a -> Int -> GenIO -> ELynx SimulateArguments ()
simulateAlignment PhyloModel
pm Tree e a
t' Int
n GenIO
g = do
  let t :: Tree Double
t = Length -> Double
fromLength (Length -> Double) -> (e -> Length) -> e -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Length
forall e. HasLength e => e -> Length
getLen (e -> Double) -> Tree e -> Tree Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree e a -> Tree e
forall e a. Tree e a -> Tree e
toTreeBranchLabels Tree e a
t'
  [[Int]]
leafStates <- case PhyloModel
pm of
    MP.SubstitutionModel SubstitutionModel
sm -> IO [[Int]]
-> ReaderT (Arguments SimulateArguments) (LoggingT IO) [[Int]]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Int]]
 -> ReaderT (Arguments SimulateArguments) (LoggingT IO) [[Int]])
-> IO [[Int]]
-> ReaderT (Arguments SimulateArguments) (LoggingT IO) [[Int]]
forall a b. (a -> b) -> a -> b
$ Int
-> StationaryDistribution
-> ExchangeabilityMatrix
-> Tree Double
-> GenIO
-> IO [[Int]]
simulateAndFlattenPar Int
n StationaryDistribution
d ExchangeabilityMatrix
e Tree Double
t GenIO
g
      where
        d :: StationaryDistribution
d = SubstitutionModel -> StationaryDistribution
MS.stationaryDistribution SubstitutionModel
sm
        e :: ExchangeabilityMatrix
e = SubstitutionModel -> ExchangeabilityMatrix
MS.exchangeabilityMatrix SubstitutionModel
sm
    MP.MixtureModel MixtureModel
mm -> do
      ([Int]
cs, [[Int]]
ss) <- IO ([Int], [[Int]])
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) ([Int], [[Int]])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Int], [[Int]])
 -> ReaderT
      (Arguments SimulateArguments) (LoggingT IO) ([Int], [[Int]]))
-> IO ([Int], [[Int]])
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) ([Int], [[Int]])
forall a b. (a -> b) -> a -> b
$ Int
-> Vector Double
-> Vector StationaryDistribution
-> Vector ExchangeabilityMatrix
-> Tree Double
-> GenIO
-> IO ([Int], [[Int]])
simulateAndFlattenMixtureModelPar Int
n Vector Double
ws Vector StationaryDistribution
ds Vector ExchangeabilityMatrix
es Tree Double
t GenIO
g
      -- TODO: Writing site distributions only makes sense for EDM models.
      -- Remove this if not needed or improve to be helpful in general.
      [Int]
-> Vector StationaryDistribution -> ELynx SimulateArguments ()
writeSiteDists [Int]
cs Vector StationaryDistribution
ds
      [[Int]]
-> ReaderT (Arguments SimulateArguments) (LoggingT IO) [[Int]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Int]]
ss
      where
        ws :: Vector Double
ws = MixtureModel -> Vector Double
MM.getWeights MixtureModel
mm
        ds :: Vector StationaryDistribution
ds = (SubstitutionModel -> StationaryDistribution)
-> Vector SubstitutionModel -> Vector StationaryDistribution
forall a b. (a -> b) -> Vector a -> Vector b
V.map SubstitutionModel -> StationaryDistribution
MS.stationaryDistribution (Vector SubstitutionModel -> Vector StationaryDistribution)
-> Vector SubstitutionModel -> Vector StationaryDistribution
forall a b. (a -> b) -> a -> b
$ MixtureModel -> Vector SubstitutionModel
MM.getSubstitutionModels MixtureModel
mm
        es :: Vector ExchangeabilityMatrix
es = (SubstitutionModel -> ExchangeabilityMatrix)
-> Vector SubstitutionModel -> Vector ExchangeabilityMatrix
forall a b. (a -> b) -> Vector a -> Vector b
V.map SubstitutionModel -> ExchangeabilityMatrix
MS.exchangeabilityMatrix (Vector SubstitutionModel -> Vector ExchangeabilityMatrix)
-> Vector SubstitutionModel -> Vector ExchangeabilityMatrix
forall a b. (a -> b) -> a -> b
$ MixtureModel -> Vector SubstitutionModel
MM.getSubstitutionModels MixtureModel
mm
  let leafNames :: [Name]
leafNames = (a -> Name) -> [a] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map a -> Name
forall a. HasName a => a -> Name
getName ([a] -> [Name]) -> [a] -> [Name]
forall a b. (a -> b) -> a -> b
$ Tree e a -> [a]
forall e a. Tree e a -> [a]
leaves Tree e a
t'
      code :: Alphabet
code = PhyloModel -> Alphabet
MP.getAlphabet PhyloModel
pm
      -- XXX: Probably use type safe stuff here?
      alph :: Set Character
alph = AlphabetSpec -> Set Character
A.all (AlphabetSpec -> Set Character) -> AlphabetSpec -> Set Character
forall a b. (a -> b) -> a -> b
$ Alphabet -> AlphabetSpec
alphabetSpec Alphabet
code
      sequences :: [Sequence]
sequences =
        [ ByteString -> ByteString -> Alphabet -> Characters -> Sequence
Seq.Sequence (Name -> ByteString
fromName Name
sName) ByteString
"" Alphabet
code ([Character] -> Characters
forall a. Unbox a => [a] -> Vector a
U.fromList ([Character] -> Characters) -> [Character] -> Characters
forall a b. (a -> b) -> a -> b
$ (Int -> Character) -> [Int] -> [Character]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Set Character -> Character
forall a. Int -> Set a -> a
`Set.elemAt` Set Character
alph) [Int]
ss)
          | (Name
sName, [Int]
ss) <- [Name] -> [[Int]] -> [(Name, [Int])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
leafNames [[Int]]
leafStates
        ]
      output :: ByteString
output = [Sequence] -> ByteString
sequencesToFasta [Sequence]
sequences
  $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
""
  FilePath -> ByteString -> FilePath -> ELynx SimulateArguments ()
forall a.
Reproducible a =>
FilePath -> ByteString -> FilePath -> ELynx a ()
out FilePath
"simulated multi sequence alignment" ByteString
output FilePath
".fasta"

-- Summarize EDM components; line to be printed to screen or log.
summarizeEDMComponents :: [EDMComponent] -> BL.ByteString
summarizeEDMComponents :: [EDMComponent] -> ByteString
summarizeEDMComponents [EDMComponent]
cs =
  FilePath -> ByteString
BL.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$
    FilePath
"Empiricial distribution mixture model with "
      FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([EDMComponent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EDMComponent]
cs)
      FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" components."

reportModel :: MP.PhyloModel -> ELynx SimulateArguments ()
reportModel :: PhyloModel -> ELynx SimulateArguments ()
reportModel PhyloModel
m = do
  GlobalArguments
as <- Arguments SimulateArguments -> GlobalArguments
forall a. Arguments a -> GlobalArguments
global (Arguments SimulateArguments -> GlobalArguments)
-> ReaderT
     (Arguments SimulateArguments)
     (LoggingT IO)
     (Arguments SimulateArguments)
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) GlobalArguments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  (Arguments SimulateArguments)
  (LoggingT IO)
  (Arguments SimulateArguments)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  if GlobalArguments -> Bool
writeElynxFile GlobalArguments
as
    then
      ( do
          let bn :: Maybe FilePath
bn = GlobalArguments -> Maybe FilePath
outFileBaseName GlobalArguments
as
          case Maybe FilePath
bn of
            Maybe FilePath
Nothing ->
              $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo)
                Text
"No output file provided; omit writing machine-readable phylogenetic model."
            Just FilePath
_ ->
              FilePath -> ByteString -> FilePath -> ELynx SimulateArguments ()
forall a.
Reproducible a =>
FilePath -> ByteString -> FilePath -> ELynx a ()
out FilePath
"model definition (machine readable)" (FilePath -> ByteString
BL.pack (PhyloModel -> FilePath
forall a. Show a => a -> FilePath
show PhyloModel
m) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n") FilePath
".model.gz"
      )
    else $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"No elynx file required; omit writing machine-readable phylogenetic model."

pretty :: Length -> String
pretty :: Length -> FilePath
pretty = FilePath -> Double -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%.5f" (Double -> FilePath) -> (Length -> Double) -> Length -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Length -> Double
fromLength

prettyRow :: String -> String -> BL.ByteString
prettyRow :: FilePath -> FilePath -> ByteString
prettyRow FilePath
name FilePath
val = Int -> ByteString -> ByteString
alignLeft Int
33 ByteString
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
alignRight Int
8 ByteString
v
  where
    n :: ByteString
n = FilePath -> ByteString
BL.pack FilePath
name
    v :: ByteString
v = FilePath -> ByteString
BL.pack FilePath
val

-- | Examine branches of a tree.
summarizeLengths :: HasLength e => Tree e a -> BL.ByteString
summarizeLengths :: Tree e a -> ByteString
summarizeLengths Tree e a
t =
  ByteString -> [ByteString] -> ByteString
BL.intercalate
    ByteString
"\n"
    [ FilePath -> FilePath -> ByteString
prettyRow FilePath
"Origin height: " (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ Length -> FilePath
pretty Length
h,
      FilePath -> FilePath -> ByteString
prettyRow FilePath
"Average distance origin to leaves: " (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ Length -> FilePath
pretty Length
h',
      FilePath -> FilePath -> ByteString
prettyRow FilePath
"Total branch length: " (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ Length -> FilePath
pretty Length
b
    ]
  where
    n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ Tree e a -> [a]
forall e a. Tree e a -> [a]
leaves Tree e a
t
    h :: Length
h = Tree e a -> Length
forall e a. HasLength e => Tree e a -> Length
height Tree e a
t
    h' :: Length
h' = [Length] -> Length
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Tree e a -> [Length]
forall e a. HasLength e => Tree e a -> [Length]
distancesOriginLeaves Tree e a
t) Length -> Length -> Length
forall a. Fractional a => a -> a -> a
/ Int -> Length
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    b :: Length
b = Tree e a -> Length
forall e a. HasLength e => Tree e a -> Length
totalBranchLength Tree e a
t

-- Summarize a substitution model; lines to be printed to screen or log.
summarizeSM :: MS.SubstitutionModel -> [BL.ByteString]
summarizeSM :: SubstitutionModel -> [ByteString]
summarizeSM SubstitutionModel
sm =
  (FilePath -> ByteString) -> [FilePath] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> ByteString
BL.pack ([FilePath] -> [ByteString]) -> [FilePath] -> [ByteString]
forall a b. (a -> b) -> a -> b
$
    (Alphabet -> FilePath
forall a. Show a => a -> FilePath
show (SubstitutionModel -> Alphabet
MS.alphabet SubstitutionModel
sm) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" substitution model: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ SubstitutionModel -> FilePath
MS.name SubstitutionModel
sm FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".") FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:
    [FilePath
"Parameters: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Double] -> FilePath
forall a. Show a => a -> FilePath
show (SubstitutionModel -> [Double]
MS.params SubstitutionModel
sm) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." | Bool -> Bool
not ([Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (SubstitutionModel -> [Double]
MS.params SubstitutionModel
sm))]
      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ case SubstitutionModel -> Alphabet
MS.alphabet SubstitutionModel
sm of
        Alphabet
DNA ->
          [ FilePath
"Stationary distribution: "
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> StationaryDistribution -> FilePath
dispv Int
precision (SubstitutionModel -> StationaryDistribution
MS.stationaryDistribution SubstitutionModel
sm)
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".",
            FilePath
"Exchangeability matrix:\n"
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> Int -> ExchangeabilityMatrix -> FilePath
dispmi Int
2 Int
precision (SubstitutionModel -> ExchangeabilityMatrix
MS.exchangeabilityMatrix SubstitutionModel
sm)
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".",
            FilePath
"Scale: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Double -> FilePath
forall a. Show a => a -> FilePath
show (Int -> Double -> Double
roundN Int
precision (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ SubstitutionModel -> Double
MS.totalRate SubstitutionModel
sm) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"."
          ]
        Alphabet
Protein ->
          [ FilePath
"Stationary distribution: "
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> StationaryDistribution -> FilePath
dispv Int
precision (SubstitutionModel -> StationaryDistribution
MS.stationaryDistribution SubstitutionModel
sm)
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".",
            FilePath
"Scale: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Double -> FilePath
forall a. Show a => a -> FilePath
show (Int -> Double -> Double
roundN Int
precision (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ SubstitutionModel -> Double
MS.totalRate SubstitutionModel
sm) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"."
          ]
        Alphabet
_ ->
          FilePath -> [FilePath]
forall a. HasCallStack => FilePath -> a
error
            FilePath
"Extended character sets are not supported with substitution models."

-- Summarize a mixture model component; lines to be printed to screen or log.
summarizeMMComponent :: MM.Component -> [BL.ByteString]
summarizeMMComponent :: Component -> [ByteString]
summarizeMMComponent Component
c =
  FilePath -> ByteString
BL.pack FilePath
"Weight: "
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (Double -> Builder) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Builder
BB.doubleDec (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ Component -> Double
MM.weight Component
c) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
  SubstitutionModel -> [ByteString]
summarizeSM (Component -> SubstitutionModel
MM.substModel Component
c)

-- Summarize a mixture model; lines to be printed to screen or log.
summarizeMM :: MM.MixtureModel -> [BL.ByteString]
summarizeMM :: MixtureModel -> [ByteString]
summarizeMM MixtureModel
m =
  [ FilePath -> ByteString
BL.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
"Mixture model: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ MixtureModel -> FilePath
MM.name MixtureModel
m FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".",
    FilePath -> ByteString
BL.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
"Number of components: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"."
  ]
    [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
detail
  where
    n :: Int
n = Vector Component -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Vector Component -> Int) -> Vector Component -> Int
forall a b. (a -> b) -> a -> b
$ MixtureModel -> Vector Component
MM.components MixtureModel
m
    detail :: [ByteString]
detail =
      if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
100
        then
          [[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ FilePath -> ByteString
BL.pack (FilePath
"Component " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":") ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Component -> [ByteString]
summarizeMMComponent Component
c
              | (Int
i, Component
c) <- [Int] -> [Component] -> [(Int, Component)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 :: Int ..] (Vector Component -> [Component]
forall a. Vector a -> [a]
V.toList (Vector Component -> [Component])
-> Vector Component -> [Component]
forall a b. (a -> b) -> a -> b
$ MixtureModel -> Vector Component
MM.components MixtureModel
m)
            ]
        else []

-- Summarize a phylogenetic model; lines to be printed to screen or log.
summarizePM :: MP.PhyloModel -> [BL.ByteString]
summarizePM :: PhyloModel -> [ByteString]
summarizePM (MP.MixtureModel MixtureModel
mm) = MixtureModel -> [ByteString]
summarizeMM MixtureModel
mm
summarizePM (MP.SubstitutionModel SubstitutionModel
sm) = SubstitutionModel -> [ByteString]
summarizeSM SubstitutionModel
sm

-- | Simulate sequences.
simulateCmd :: ELynx SimulateArguments ()
simulateCmd :: ELynx SimulateArguments ()
simulateCmd = do
  SimulateArguments
l <- Arguments SimulateArguments -> SimulateArguments
forall a. Arguments a -> a
local (Arguments SimulateArguments -> SimulateArguments)
-> ReaderT
     (Arguments SimulateArguments)
     (LoggingT IO)
     (Arguments SimulateArguments)
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) SimulateArguments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  (Arguments SimulateArguments)
  (LoggingT IO)
  (Arguments SimulateArguments)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let treeFile :: FilePath
treeFile = SimulateArguments -> FilePath
argsTreeFile SimulateArguments
l
  $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
""
  $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ELynx SimulateArguments ())
-> Text -> ELynx SimulateArguments ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"Read tree from file '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
treeFile FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'."
  Tree Phylo Name
tree <- IO (Tree Phylo Name)
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) (Tree Phylo Name)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tree Phylo Name)
 -> ReaderT
      (Arguments SimulateArguments) (LoggingT IO) (Tree Phylo Name))
-> IO (Tree Phylo Name)
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) (Tree Phylo Name)
forall a b. (a -> b) -> a -> b
$ Parser (Tree Phylo Name) -> FilePath -> IO (Tree Phylo Name)
forall a. Parser a -> FilePath -> IO a
parseFileWith (NewickFormat -> Parser (Tree Phylo Name)
newick NewickFormat
Standard) FilePath
treeFile
  let t' :: Tree Length Name
t' = (FilePath -> Tree Length Name)
-> (Tree Length Name -> Tree Length Name)
-> Either FilePath (Tree Length Name)
-> Tree Length Name
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> Tree Length Name
forall a. HasCallStack => FilePath -> a
error Tree Length Name -> Tree Length Name
forall a. a -> a
id (Either FilePath (Tree Length Name) -> Tree Length Name)
-> Either FilePath (Tree Length Name) -> Tree Length Name
forall a b. (a -> b) -> a -> b
$ Tree Phylo Name -> Either FilePath (Tree Length Name)
forall a. Tree Phylo a -> Either FilePath (Tree Length a)
phyloToLengthTree Tree Phylo Name
tree
  $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ELynx SimulateArguments ())
-> Text -> ELynx SimulateArguments ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"Number of leaves: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Name] -> Int) -> [Name] -> Int
forall a b. (a -> b) -> a -> b
$ Tree Length Name -> [Name]
forall e a. Tree e a -> [a]
leaves Tree Length Name
t')
  $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ELynx SimulateArguments ())
-> Text -> ELynx SimulateArguments ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
LT.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
LT.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Tree Length Name -> ByteString
forall e a. HasLength e => Tree e a -> ByteString
summarizeLengths Tree Length Name
t'
  let edmFile :: Maybe FilePath
edmFile = SimulateArguments -> Maybe FilePath
argsEDMFile SimulateArguments
l
  let sProfileFiles :: Maybe [FilePath]
sProfileFiles = SimulateArguments -> Maybe [FilePath]
argsSiteprofilesFiles SimulateArguments
l
  $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
""
  $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) Text
"Read EDM file or siteprofile files."
  Bool -> ELynx SimulateArguments () -> ELynx SimulateArguments ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
edmFile Bool -> Bool -> Bool
&& Maybe [FilePath] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [FilePath]
sProfileFiles) (ELynx SimulateArguments () -> ELynx SimulateArguments ())
-> ELynx SimulateArguments () -> ELynx SimulateArguments ()
forall a b. (a -> b) -> a -> b
$
    FilePath -> ELynx SimulateArguments ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Got both: --edm-file and --siteprofile-files."
  Maybe [EDMComponent]
edmCs <- case Maybe FilePath
edmFile of
    Maybe FilePath
Nothing -> Maybe [EDMComponent]
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) (Maybe [EDMComponent])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [EDMComponent]
forall a. Maybe a
Nothing
    Just FilePath
edmF -> do
      $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Read EDM file."
      IO (Maybe [EDMComponent])
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) (Maybe [EDMComponent])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [EDMComponent])
 -> ReaderT
      (Arguments SimulateArguments) (LoggingT IO) (Maybe [EDMComponent]))
-> IO (Maybe [EDMComponent])
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) (Maybe [EDMComponent])
forall a b. (a -> b) -> a -> b
$ [EDMComponent] -> Maybe [EDMComponent]
forall a. a -> Maybe a
Just ([EDMComponent] -> Maybe [EDMComponent])
-> IO [EDMComponent] -> IO (Maybe [EDMComponent])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [EDMComponent] -> FilePath -> IO [EDMComponent]
forall a. Parser a -> FilePath -> IO a
parseFileWith Parser [EDMComponent]
phylobayes FilePath
edmF
  ELynx SimulateArguments ()
-> ([EDMComponent] -> ELynx SimulateArguments ())
-> Maybe [EDMComponent]
-> ELynx SimulateArguments ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (() -> ELynx SimulateArguments ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    ($(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ELynx SimulateArguments ())
-> ([EDMComponent] -> Text)
-> [EDMComponent]
-> ELynx SimulateArguments ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict (Text -> Text)
-> ([EDMComponent] -> Text) -> [EDMComponent] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
LT.decodeUtf8 (ByteString -> Text)
-> ([EDMComponent] -> ByteString) -> [EDMComponent] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EDMComponent] -> ByteString
summarizeEDMComponents)
    Maybe [EDMComponent]
edmCs
  Maybe [EDMComponent]
sProfiles <- case Maybe [FilePath]
sProfileFiles of
    Maybe [FilePath]
Nothing -> Maybe [EDMComponent]
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) (Maybe [EDMComponent])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [EDMComponent]
forall a. Maybe a
Nothing
    Just [FilePath]
fns -> do
      $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ELynx SimulateArguments ())
-> Text -> ELynx SimulateArguments ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$
          FilePath
"Read siteprofiles from "
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
fns)
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" file(s)."
      $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) (Text -> ELynx SimulateArguments ())
-> Text -> ELynx SimulateArguments ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"The file names are:" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
fns
      [[EDMComponent]]
xs <- IO [[EDMComponent]]
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) [[EDMComponent]]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[EDMComponent]]
 -> ReaderT
      (Arguments SimulateArguments) (LoggingT IO) [[EDMComponent]])
-> IO [[EDMComponent]]
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) [[EDMComponent]]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO [EDMComponent])
-> [FilePath] -> IO [[EDMComponent]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Parser [EDMComponent] -> FilePath -> IO [EDMComponent]
forall a. Parser a -> FilePath -> IO a
parseFileWith Parser [EDMComponent]
siteprofiles) [FilePath]
fns
      Maybe [EDMComponent]
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) (Maybe [EDMComponent])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [EDMComponent]
 -> ReaderT
      (Arguments SimulateArguments) (LoggingT IO) (Maybe [EDMComponent]))
-> Maybe [EDMComponent]
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) (Maybe [EDMComponent])
forall a b. (a -> b) -> a -> b
$ [EDMComponent] -> Maybe [EDMComponent]
forall a. a -> Maybe a
Just ([EDMComponent] -> Maybe [EDMComponent])
-> [EDMComponent] -> Maybe [EDMComponent]
forall a b. (a -> b) -> a -> b
$ [[EDMComponent]] -> [EDMComponent]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[EDMComponent]]
xs
  ELynx SimulateArguments ()
-> ([EDMComponent] -> ELynx SimulateArguments ())
-> Maybe [EDMComponent]
-> ELynx SimulateArguments ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (() -> ELynx SimulateArguments ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    ($(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ELynx SimulateArguments ())
-> ([EDMComponent] -> Text)
-> [EDMComponent]
-> ELynx SimulateArguments ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict (Text -> Text)
-> ([EDMComponent] -> Text) -> [EDMComponent] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
LT.decodeUtf8 (ByteString -> Text)
-> ([EDMComponent] -> ByteString) -> [EDMComponent] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EDMComponent] -> ByteString
summarizeEDMComponents)
    Maybe [EDMComponent]
sProfiles
  let edmCsOrSiteprofiles :: Maybe [EDMComponent]
edmCsOrSiteprofiles = Maybe [EDMComponent]
edmCs Maybe [EDMComponent]
-> Maybe [EDMComponent] -> Maybe [EDMComponent]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [EDMComponent]
sProfiles
  $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Read model string."
  let ms :: Maybe FilePath
ms = SimulateArguments -> Maybe FilePath
argsSubstitutionModelString SimulateArguments
l
      mm :: Maybe FilePath
mm = SimulateArguments -> Maybe FilePath
argsMixtureModelString SimulateArguments
l
      mws :: Maybe [Double]
mws = SimulateArguments -> Maybe [Double]
argsMixtureWeights SimulateArguments
l
      eitherPhyloModel' :: Either FilePath PhyloModel
eitherPhyloModel' = Maybe FilePath
-> Maybe FilePath
-> Maybe [Double]
-> Maybe [EDMComponent]
-> Either FilePath PhyloModel
getPhyloModel Maybe FilePath
ms Maybe FilePath
mm Maybe [Double]
mws Maybe [EDMComponent]
edmCsOrSiteprofiles
  PhyloModel
phyloModel' <- case Either FilePath PhyloModel
eitherPhyloModel' of
    Left FilePath
err -> LoggingT IO PhyloModel
-> ReaderT (Arguments SimulateArguments) (LoggingT IO) PhyloModel
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT IO PhyloModel
 -> ReaderT (Arguments SimulateArguments) (LoggingT IO) PhyloModel)
-> LoggingT IO PhyloModel
-> ReaderT (Arguments SimulateArguments) (LoggingT IO) PhyloModel
forall a b. (a -> b) -> a -> b
$ FilePath -> LoggingT IO PhyloModel
forall a. HasCallStack => FilePath -> a
error FilePath
err
    Right PhyloModel
pm -> PhyloModel
-> ReaderT (Arguments SimulateArguments) (LoggingT IO) PhyloModel
forall (m :: * -> *) a. Monad m => a -> m a
return PhyloModel
pm
  let maybeGammaParams :: Maybe GammaRateHeterogeneityParams
maybeGammaParams = SimulateArguments -> Maybe GammaRateHeterogeneityParams
argsGammaParams SimulateArguments
l
  PhyloModel
phyloModel <- case Maybe GammaRateHeterogeneityParams
maybeGammaParams of
    Maybe GammaRateHeterogeneityParams
Nothing -> do
      $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ELynx SimulateArguments ())
-> Text -> ELynx SimulateArguments ()
forall a b. (a -> b) -> a -> b
$
        Text -> Text
LT.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
          ByteString -> Text
LT.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$
            [ByteString] -> ByteString
BL.unlines ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
              PhyloModel -> [ByteString]
summarizePM
                PhyloModel
phyloModel'
      PhyloModel
-> ReaderT (Arguments SimulateArguments) (LoggingT IO) PhyloModel
forall (m :: * -> *) a. Monad m => a -> m a
return PhyloModel
phyloModel'
    Just (Int
n, Double
alpha) -> do
      $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ELynx SimulateArguments ())
-> Text -> ELynx SimulateArguments ()
forall a b. (a -> b) -> a -> b
$
        Text -> Text
LT.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
          ByteString -> Text
LT.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$
            ByteString -> [ByteString] -> ByteString
BL.intercalate ByteString
"\n" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
              PhyloModel -> [ByteString]
summarizePM PhyloModel
phyloModel'
      $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
""
      $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ELynx SimulateArguments ())
-> Text -> ELynx SimulateArguments ()
forall a b. (a -> b) -> a -> b
$
        Text -> Text
LT.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
          ByteString -> Text
LT.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$
            ByteString -> [ByteString] -> ByteString
BL.intercalate ByteString
"\n" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
              Int -> Double -> [ByteString]
summarizeGammaRateHeterogeneity Int
n Double
alpha
      PhyloModel
-> ReaderT (Arguments SimulateArguments) (LoggingT IO) PhyloModel
forall (m :: * -> *) a. Monad m => a -> m a
return (PhyloModel
 -> ReaderT (Arguments SimulateArguments) (LoggingT IO) PhyloModel)
-> PhyloModel
-> ReaderT (Arguments SimulateArguments) (LoggingT IO) PhyloModel
forall a b. (a -> b) -> a -> b
$ Int -> Double -> PhyloModel -> PhyloModel
expand Int
n Double
alpha PhyloModel
phyloModel'
  PhyloModel -> ELynx SimulateArguments ()
reportModel PhyloModel
phyloModel
  $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Simulate alignment."
  let alignmentLength :: Int
alignmentLength = SimulateArguments -> Int
argsLength SimulateArguments
l
  $(Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> (Int, Int) -> (Int, Int) -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx SimulateArguments ()
(Text -> ELynx SimulateArguments ())
-> (Text -> Text) -> Text -> ELynx SimulateArguments ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ELynx SimulateArguments ())
-> Text -> ELynx SimulateArguments ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"Length: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
alignmentLength FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"."
  Gen RealWorld
gen <- case SimulateArguments -> Seed
argsSeed SimulateArguments
l of
    Seed
Random -> FilePath
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) (Gen RealWorld)
forall a. HasCallStack => FilePath -> a
error FilePath
"simulateCmd: seed not available; please contact maintainer."
    Fixed Vector Word32
s -> IO (Gen RealWorld)
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) (Gen RealWorld)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Gen RealWorld)
 -> ReaderT
      (Arguments SimulateArguments) (LoggingT IO) (Gen RealWorld))
-> IO (Gen RealWorld)
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) (Gen RealWorld)
forall a b. (a -> b) -> a -> b
$ Vector Word32 -> IO GenIO
forall (m :: * -> *) (v :: * -> *).
(PrimMonad m, Vector v Word32) =>
v Word32 -> m (Gen (PrimState m))
initialize Vector Word32
s
  PhyloModel
-> Tree Length Name -> Int -> GenIO -> ELynx SimulateArguments ()
forall e a.
(HasLength e, HasName a) =>
PhyloModel
-> Tree e a -> Int -> GenIO -> ELynx SimulateArguments ()
simulateAlignment PhyloModel
phyloModel Tree Length Name
t' Int
alignmentLength Gen RealWorld
GenIO
gen