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

-- |
-- Module      :  SLynx.Simulate.Simulate
-- Description :  Simulate multiple sequence alignments
-- Copyright   :  (c) Dominik Schrempf 2020
-- 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.Concurrent
import Control.Concurrent.Async
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.NonEmpty (toList)
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.Unboxed as V
import ELynx.Data.Alphabet.Alphabet as A
import ELynx.Data.MarkovProcess.GammaRateHeterogeneity
import qualified ELynx.Data.MarkovProcess.MixtureModel as M
import qualified ELynx.Data.MarkovProcess.PhyloModel as P
import qualified ELynx.Data.MarkovProcess.SubstitutionModel as SM
import qualified ELynx.Data.Sequence.Alignment as A
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 Numeric.LinearAlgebra hiding
  ( toList,
    (<>),
  )
import SLynx.Simulate.Options
import SLynx.Simulate.PhyloModel
import System.Random.MWC
import Text.Printf

-- Simulate a 'Alignment' for a given phylogenetic model,
-- phylogenetic tree, and alignment length.
simulateAlignment ::
  (HasLength e, HasName a) =>
  P.PhyloModel ->
  Tree e a ->
  Int ->
  GenIO ->
  IO A.Alignment
simulateAlignment :: PhyloModel -> Tree e a -> Int -> GenIO -> IO Alignment
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
c <- IO Int
getNumCapabilities
  [Gen RealWorld]
gs <- Int -> GenIO -> IO [GenIO]
forall (m :: * -> *).
PrimMonad m =>
Int -> Gen (PrimState m) -> m [Gen (PrimState m)]
splitGen Int
c GenIO
g
  let chunks :: [Int]
chunks = Int -> Int -> [Int]
getChunks Int
c Int
n
  [[[Int]]]
leafStatesS <- case PhyloModel
pm of
    -- TODO @performace: This parallelization is not very intelligent, because
    -- the matrix exponentiation is done in all threads. So ten threads will
    -- exponentiate the same matrix ten times.
    P.SubstitutionModel SubstitutionModel
sm ->
      ((Int, Gen RealWorld) -> IO [[Int]])
-> [(Int, Gen RealWorld)] -> IO [[[Int]]]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently
        (\(Int
num, Gen RealWorld
gen) -> Int
-> StationaryDistribution
-> ExchangeabilityMatrix
-> Tree Double
-> GenIO
-> IO [[Int]]
forall (m :: * -> *).
PrimMonad m =>
Int
-> StationaryDistribution
-> ExchangeabilityMatrix
-> Tree Double
-> Gen (PrimState m)
-> m [[Int]]
simulateAndFlatten Int
num StationaryDistribution
d ExchangeabilityMatrix
e Tree Double
t Gen RealWorld
GenIO
gen)
        ([Int] -> [Gen RealWorld] -> [(Int, Gen RealWorld)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
chunks [Gen RealWorld]
gs)
      where
        d :: StationaryDistribution
d = SubstitutionModel -> StationaryDistribution
SM.stationaryDistribution SubstitutionModel
sm
        e :: ExchangeabilityMatrix
e = SubstitutionModel -> ExchangeabilityMatrix
SM.exchangeabilityMatrix SubstitutionModel
sm
    -- P.MixtureModel mm      -> mapConcurrently
    --   (\(num, gen) -> simulateAndFlattenNSitesAlongTreeMixtureModel num ws ds es t gen) (zip chunks gs)
    P.MixtureModel MixtureModel
mm -> Int
-> StationaryDistribution
-> [StationaryDistribution]
-> [ExchangeabilityMatrix]
-> Tree Double
-> GenIO
-> IO [[[Int]]]
simulateAndFlattenMixtureModelPar Int
n StationaryDistribution
ws [StationaryDistribution]
ds [ExchangeabilityMatrix]
es Tree Double
t GenIO
g
      where
        ws :: StationaryDistribution
ws = [Double] -> StationaryDistribution
vector ([Double] -> StationaryDistribution)
-> (NonEmpty Double -> [Double])
-> NonEmpty Double
-> StationaryDistribution
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Double -> [Double]
forall a. NonEmpty a -> [a]
toList (NonEmpty Double -> StationaryDistribution)
-> NonEmpty Double -> StationaryDistribution
forall a b. (a -> b) -> a -> b
$ MixtureModel -> NonEmpty Double
M.getWeights MixtureModel
mm
        ds :: [StationaryDistribution]
ds = (SubstitutionModel -> StationaryDistribution)
-> [SubstitutionModel] -> [StationaryDistribution]
forall a b. (a -> b) -> [a] -> [b]
map SubstitutionModel -> StationaryDistribution
SM.stationaryDistribution ([SubstitutionModel] -> [StationaryDistribution])
-> [SubstitutionModel] -> [StationaryDistribution]
forall a b. (a -> b) -> a -> b
$ NonEmpty SubstitutionModel -> [SubstitutionModel]
forall a. NonEmpty a -> [a]
toList (NonEmpty SubstitutionModel -> [SubstitutionModel])
-> NonEmpty SubstitutionModel -> [SubstitutionModel]
forall a b. (a -> b) -> a -> b
$ MixtureModel -> NonEmpty SubstitutionModel
M.getSubstitutionModels MixtureModel
mm
        es :: [ExchangeabilityMatrix]
es = (SubstitutionModel -> ExchangeabilityMatrix)
-> [SubstitutionModel] -> [ExchangeabilityMatrix]
forall a b. (a -> b) -> [a] -> [b]
map SubstitutionModel -> ExchangeabilityMatrix
SM.exchangeabilityMatrix ([SubstitutionModel] -> [ExchangeabilityMatrix])
-> [SubstitutionModel] -> [ExchangeabilityMatrix]
forall a b. (a -> b) -> a -> b
$ NonEmpty SubstitutionModel -> [SubstitutionModel]
forall a. NonEmpty a -> [a]
toList (NonEmpty SubstitutionModel -> [SubstitutionModel])
-> NonEmpty SubstitutionModel -> [SubstitutionModel]
forall a b. (a -> b) -> a -> b
$ MixtureModel -> NonEmpty SubstitutionModel
M.getSubstitutionModels MixtureModel
mm
  -- XXX @performace. The horizontal concatenation might be slow. If so,
  -- 'concatenateSeqs' or 'concatenateAlignments' can be used, which directly
  -- appends vectors.
  let leafStates :: [[Int]]
leafStates = [[[Int]]] -> [[Int]]
forall a. [[[a]]] -> [[a]]
horizontalConcat [[[Int]]]
leafStatesS
      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
P.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 =
        [ Name -> Name -> Alphabet -> Characters -> Sequence
Seq.Sequence (Name -> Name
fromName Name
sName) Name
"" Alphabet
code ([Character] -> Characters
forall a. Unbox a => [a] -> Vector a
V.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
        ]
  Alignment -> IO Alignment
forall (m :: * -> *) a. Monad m => a -> m a
return (Alignment -> IO Alignment) -> Alignment -> IO Alignment
forall a b. (a -> b) -> a -> b
$ ([Char] -> Alignment)
-> (Alignment -> Alignment) -> Either [Char] Alignment -> Alignment
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Alignment
forall a. HasCallStack => [Char] -> a
error Alignment -> Alignment
forall a. a -> a
id (Either [Char] Alignment -> Alignment)
-> Either [Char] Alignment -> Alignment
forall a b. (a -> b) -> a -> b
$ [Sequence] -> Either [Char] Alignment
A.fromSequences [Sequence]
sequences

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

reportModel :: P.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 [Char]
bn = GlobalArguments -> Maybe [Char]
outFileBaseName GlobalArguments
as
             case Maybe [Char]
bn of
               Maybe [Char]
Nothing ->
                 $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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 [Char]
_ ->
                 [Char] -> Name -> [Char] -> ELynx SimulateArguments ()
forall a. Reproducible a => [Char] -> Name -> [Char] -> ELynx a ()
out [Char]
"model definition (machine readable)" ([Char] -> Name
BL.pack (PhyloModel -> [Char]
forall a. Show a => a -> [Char]
show PhyloModel
m) Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"\n") [Char]
".model.gz")
    else $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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 -> [Char]
pretty = [Char] -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%.5f" (Double -> [Char]) -> (Length -> Double) -> Length -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Length -> Double
fromLength

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

-- | Examine branches of a tree.
summarizeLengths :: HasLength e => Tree e a -> BL.ByteString
summarizeLengths :: Tree e a -> Name
summarizeLengths Tree e a
t =
  Name -> [Name] -> Name
BL.intercalate
    Name
"\n"
    [ [Char] -> [Char] -> Name
prettyRow [Char]
"Origin height: " ([Char] -> Name) -> [Char] -> Name
forall a b. (a -> b) -> a -> b
$ Length -> [Char]
pretty Length
h,
      [Char] -> [Char] -> Name
prettyRow [Char]
"Average distance origin to leaves: " ([Char] -> Name) -> [Char] -> Name
forall a b. (a -> b) -> a -> b
$ Length -> [Char]
pretty Length
h',
      [Char] -> [Char] -> Name
prettyRow [Char]
"Total branch length: " ([Char] -> Name) -> [Char] -> Name
forall a b. (a -> b) -> a -> b
$ Length -> [Char]
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 :: SM.SubstitutionModel -> [BL.ByteString]
summarizeSM :: SubstitutionModel -> [Name]
summarizeSM SubstitutionModel
sm =
  ([Char] -> Name) -> [[Char]] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Name
BL.pack ([[Char]] -> [Name]) -> [[Char]] -> [Name]
forall a b. (a -> b) -> a -> b
$
    (Alphabet -> [Char]
forall a. Show a => a -> [Char]
show (SubstitutionModel -> Alphabet
SM.alphabet SubstitutionModel
sm) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" substitution model: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SubstitutionModel -> [Char]
SM.name SubstitutionModel
sm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".") [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
    [[Char]
"Parameters: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Double] -> [Char]
forall a. Show a => a -> [Char]
show (SubstitutionModel -> [Double]
SM.params SubstitutionModel
sm) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." | Bool -> Bool
not ([Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (SubstitutionModel -> [Double]
SM.params SubstitutionModel
sm))]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ case SubstitutionModel -> Alphabet
SM.alphabet SubstitutionModel
sm of
        Alphabet
DNA ->
          [ [Char]
"Stationary distribution: "
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> StationaryDistribution -> [Char]
dispv Int
precision (SubstitutionModel -> StationaryDistribution
SM.stationaryDistribution SubstitutionModel
sm)
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".",
            [Char]
"Exchangeability matrix:\n"
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> ExchangeabilityMatrix -> [Char]
dispmi Int
2 Int
precision (SubstitutionModel -> ExchangeabilityMatrix
SM.exchangeabilityMatrix SubstitutionModel
sm)
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".",
            [Char]
"Scale: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Double -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Double -> Double
roundN Int
precision (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ SubstitutionModel -> Double
SM.totalRate SubstitutionModel
sm) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
          ]
        Alphabet
Protein ->
          [ [Char]
"Stationary distribution: "
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> StationaryDistribution -> [Char]
dispv Int
precision (SubstitutionModel -> StationaryDistribution
SM.stationaryDistribution SubstitutionModel
sm)
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".",
            [Char]
"Scale: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Double -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Double -> Double
roundN Int
precision (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ SubstitutionModel -> Double
SM.totalRate SubstitutionModel
sm) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
          ]
        Alphabet
_ ->
          [Char] -> [[Char]]
forall a. HasCallStack => [Char] -> a
error
            [Char]
"Extended character sets are not supported with substitution models."

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

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

-- Summarize a phylogenetic model; lines to be printed to screen or log.
summarizePM :: P.PhyloModel -> [BL.ByteString]
summarizePM :: PhyloModel -> [Name]
summarizePM (P.MixtureModel MixtureModel
mm) = MixtureModel -> [Name]
summarizeMM MixtureModel
mm
summarizePM (P.SubstitutionModel SubstitutionModel
sm) = SubstitutionModel -> [Name]
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 :: [Char]
treeFile = SimulateArguments -> [Char]
argsTreeFile SimulateArguments
l
  $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Read tree from file '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
treeFile [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'."
  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) -> [Char] -> IO (Tree Phylo Name)
forall a. Parser a -> [Char] -> IO a
parseFileWith (NewickFormat -> Parser (Tree Phylo Name)
newick NewickFormat
Standard) [Char]
treeFile
  let t' :: Tree Length Name
t' = ([Char] -> Tree Length Name)
-> (Tree Length Name -> Tree Length Name)
-> Either [Char] (Tree Length Name)
-> Tree Length Name
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Tree Length Name
forall a. HasCallStack => [Char] -> a
error Tree Length Name -> Tree Length Name
forall a. a -> a
id (Either [Char] (Tree Length Name) -> Tree Length Name)
-> Either [Char] (Tree Length Name) -> Tree Length Name
forall a b. (a -> b) -> a -> b
$ Tree Phylo Name -> Either [Char] (Tree Length Name)
forall a. Tree Phylo a -> Either [Char] (Tree Length a)
phyloToLengthTree Tree Phylo Name
tree
  $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Number of leaves: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
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
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
$ Name -> Text
LT.decodeUtf8 (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ Tree Length Name -> Name
forall e a. HasLength e => Tree e a -> Name
summarizeLengths Tree Length Name
t'
  let edmFile :: Maybe [Char]
edmFile = SimulateArguments -> Maybe [Char]
argsEDMFile SimulateArguments
l
  let sProfileFiles :: Maybe [[Char]]
sProfileFiles = SimulateArguments -> Maybe [[Char]]
argsSiteprofilesFiles SimulateArguments
l
  $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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 [Char] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [Char]
edmFile Bool -> Bool -> Bool
&& Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [[Char]]
sProfileFiles) (ELynx SimulateArguments () -> ELynx SimulateArguments ())
-> ELynx SimulateArguments () -> ELynx SimulateArguments ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> ELynx SimulateArguments ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Got both: --edm-file and --siteprofile-files."
  Maybe [EDMComponent]
edmCs <- case Maybe [Char]
edmFile of
    Maybe [Char]
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 [Char]
edmF -> do
      $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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] -> [Char] -> IO [EDMComponent]
forall a. Parser a -> [Char] -> IO a
parseFileWith Parser [EDMComponent]
phylobayes [Char]
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
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
. Name -> Text
LT.decodeUtf8 (Name -> Text)
-> ([EDMComponent] -> Name) -> [EDMComponent] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EDMComponent] -> Name
summarizeEDMComponents)
    Maybe [EDMComponent]
edmCs
  Maybe [EDMComponent]
sProfiles <- case Maybe [[Char]]
sProfileFiles of
    Maybe [[Char]]
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 [[Char]]
fns -> do
      $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
$
        [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$
          [Char]
"Read siteprofiles from "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
fns)
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" file(s)."
      $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"The file names are:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
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
$ ([Char] -> IO [EDMComponent]) -> [[Char]] -> IO [[EDMComponent]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Parser [EDMComponent] -> [Char] -> IO [EDMComponent]
forall a. Parser a -> [Char] -> IO a
parseFileWith Parser [EDMComponent]
siteprofiles) [[Char]]
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
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
. Name -> Text
LT.decodeUtf8 (Name -> Text)
-> ([EDMComponent] -> Name) -> [EDMComponent] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EDMComponent] -> Name
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
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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 [Char]
ms = SimulateArguments -> Maybe [Char]
argsSubstitutionModelString SimulateArguments
l
      mm :: Maybe [Char]
mm = SimulateArguments -> Maybe [Char]
argsMixtureModelString SimulateArguments
l
      mws :: Maybe [Double]
mws = SimulateArguments -> Maybe [Double]
argsMixtureWeights SimulateArguments
l
      eitherPhyloModel' :: Either [Char] PhyloModel
eitherPhyloModel' = Maybe [Char]
-> Maybe [Char]
-> Maybe [Double]
-> Maybe [EDMComponent]
-> Either [Char] PhyloModel
getPhyloModel Maybe [Char]
ms Maybe [Char]
mm Maybe [Double]
mws Maybe [EDMComponent]
edmCsOrSiteprofiles
  PhyloModel
phyloModel' <- case Either [Char] PhyloModel
eitherPhyloModel' of
    Left [Char]
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
$ [Char] -> LoggingT IO PhyloModel
forall a. HasCallStack => [Char] -> a
error [Char]
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
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
$
          Name -> Text
LT.decodeUtf8 (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$
            [Name] -> Name
BL.unlines ([Name] -> Name) -> [Name] -> Name
forall a b. (a -> b) -> a -> b
$
              PhyloModel -> [Name]
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
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
$
          Name -> Text
LT.decodeUtf8 (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$
            Name -> [Name] -> Name
BL.intercalate Name
"\n" ([Name] -> Name) -> [Name] -> Name
forall a b. (a -> b) -> a -> b
$
              PhyloModel -> [Name]
summarizePM PhyloModel
phyloModel'
      $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
$
          Name -> Text
LT.decodeUtf8 (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$
            Name -> [Name] -> Name
BL.intercalate Name
"\n" ([Name] -> Name) -> [Name] -> Name
forall a b. (a -> b) -> a -> b
$
              Int -> Double -> [Name]
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
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Length: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
alignmentLength [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
  Gen RealWorld
gen <- case SimulateArguments -> Seed
argsSeed SimulateArguments
l of
    Seed
Random ->
      [Char]
-> ReaderT
     (Arguments SimulateArguments) (LoggingT IO) (Gen RealWorld)
forall a. HasCallStack => [Char] -> a
error [Char]
"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
  Alignment
alignment <- IO Alignment
-> ReaderT (Arguments SimulateArguments) (LoggingT IO) Alignment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Alignment
 -> ReaderT (Arguments SimulateArguments) (LoggingT IO) Alignment)
-> IO Alignment
-> ReaderT (Arguments SimulateArguments) (LoggingT IO) Alignment
forall a b. (a -> b) -> a -> b
$ PhyloModel -> Tree Length Name -> Int -> GenIO -> IO Alignment
forall e a.
(HasLength e, HasName a) =>
PhyloModel -> Tree e a -> Int -> GenIO -> IO Alignment
simulateAlignment PhyloModel
phyloModel Tree Length Name
t' Int
alignmentLength Gen RealWorld
GenIO
gen
  let output :: Name
output = ([Sequence] -> Name
sequencesToFasta ([Sequence] -> Name)
-> (Alignment -> [Sequence]) -> Alignment -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> [Sequence]
A.toSequences) Alignment
alignment
  $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> 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 :: [Char] -> 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
""
  [Char] -> Name -> [Char] -> ELynx SimulateArguments ()
forall a. Reproducible a => [Char] -> Name -> [Char] -> ELynx a ()
out [Char]
"simulated multi sequence alignment" Name
output [Char]
".fasta"