{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module TLynx.Simulate.Options
( Process (..),
SimulateArguments (..),
simulateArguments,
reportSimulateArguments,
)
where
import Data.Aeson
import Data.List
import Data.Maybe
import ELynx.Tools.Options
import ELynx.Tools.Reproduction
import ELynx.Tree.Simulate.PointProcess (TimeSpec (..))
import GHC.Generics
import Options.Applicative
deriving instance Eq TimeSpec
deriving instance Generic TimeSpec
instance Show TimeSpec where
show :: TimeSpec -> [Char]
show TimeSpec
Random = [Char]
"Random"
show (Origin Double
o) = [Char]
"Condition on height of origin: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Double
o
show (Mrca Double
m) = [Char]
"Condition on height of MRCA: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Double
m
instance FromJSON TimeSpec
instance ToJSON TimeSpec
data Process
= BirthDeath
{
Process -> Double
bdLambda :: Double,
Process -> Double
bdMu :: Double,
Process -> Maybe Double
bdRho :: Maybe Double,
Process -> TimeSpec
bdHeight :: TimeSpec
}
| Coalescent
deriving (Process -> Process -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Process -> Process -> Bool
$c/= :: Process -> Process -> Bool
== :: Process -> Process -> Bool
$c== :: Process -> Process -> Bool
Eq, Int -> Process -> ShowS
[Process] -> ShowS
Process -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Process] -> ShowS
$cshowList :: [Process] -> ShowS
show :: Process -> [Char]
$cshow :: Process -> [Char]
showsPrec :: Int -> Process -> ShowS
$cshowsPrec :: Int -> Process -> ShowS
Show, forall x. Rep Process x -> Process
forall x. Process -> Rep Process x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Process x -> Process
$cfrom :: forall x. Process -> Rep Process x
Generic)
instance FromJSON Process
instance ToJSON Process
reportProcess :: Process -> String
reportProcess :: Process -> [Char]
reportProcess (BirthDeath Double
l Double
m Maybe Double
mr TimeSpec
ts) =
forall a. [a] -> [[a]] -> [a]
intercalate
[Char]
"\n"
[ [Char]
"Model: Birth and death process",
[Char]
" Birth rate: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Double
l,
[Char]
" Death rate: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Double
m,
[Char]
" Sampling probability: " forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"1.0" forall a. Show a => a -> [Char]
show Maybe Double
mr,
[Char]
" Height specification: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show TimeSpec
ts
]
reportProcess Process
Coalescent = [Char]
"Model: Coalescent process"
data SimulateArguments = SimulateArguments
{
SimulateArguments -> Int
argsNTrees :: Int,
SimulateArguments -> Int
argsNLeaves :: Int,
SimulateArguments -> Process
argsProcess :: Process,
SimulateArguments -> Maybe Double
argsSubSample :: Maybe Double,
SimulateArguments -> Bool
argsSumStat :: Bool,
SimulateArguments -> SeedOpt
argsSeed :: SeedOpt
}
deriving (SimulateArguments -> SimulateArguments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimulateArguments -> SimulateArguments -> Bool
$c/= :: SimulateArguments -> SimulateArguments -> Bool
== :: SimulateArguments -> SimulateArguments -> Bool
$c== :: SimulateArguments -> SimulateArguments -> Bool
Eq, Int -> SimulateArguments -> ShowS
[SimulateArguments] -> ShowS
SimulateArguments -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SimulateArguments] -> ShowS
$cshowList :: [SimulateArguments] -> ShowS
show :: SimulateArguments -> [Char]
$cshow :: SimulateArguments -> [Char]
showsPrec :: Int -> SimulateArguments -> ShowS
$cshowsPrec :: Int -> SimulateArguments -> ShowS
Show, forall x. Rep SimulateArguments x -> SimulateArguments
forall x. SimulateArguments -> Rep SimulateArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SimulateArguments x -> SimulateArguments
$cfrom :: forall x. SimulateArguments -> Rep SimulateArguments x
Generic)
instance Reproducible SimulateArguments where
inFiles :: SimulateArguments -> [[Char]]
inFiles SimulateArguments
_ = []
outSuffixes :: SimulateArguments -> [[Char]]
outSuffixes SimulateArguments
_ = [[Char]
".tree"]
getSeed :: SimulateArguments -> Maybe SeedOpt
getSeed = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimulateArguments -> SeedOpt
argsSeed
setSeed :: SimulateArguments -> SeedOpt -> SimulateArguments
setSeed SimulateArguments
a SeedOpt
s = SimulateArguments
a {argsSeed :: SeedOpt
argsSeed = SeedOpt
s}
parser :: Parser SimulateArguments
parser = Parser SimulateArguments
simulateArguments
cmdName :: [Char]
cmdName = [Char]
"simulate"
cmdDsc :: [[Char]]
cmdDsc = [[Char]
"Simulate phylogenetic trees using a birth and death or coalescent process."]
cmdFtr :: [[Char]]
cmdFtr = [[Char]]
simulateFooter
instance FromJSON SimulateArguments
instance ToJSON SimulateArguments
reportSimulateArguments :: SimulateArguments -> String
reportSimulateArguments :: SimulateArguments -> [Char]
reportSimulateArguments SimulateArguments
a =
forall a. [a] -> [[a]] -> [a]
intercalate
[Char]
"\n"
[ [Char]
"Number of simulated trees: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (SimulateArguments -> Int
argsNTrees SimulateArguments
a),
[Char]
"Number of leaves per tree: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (SimulateArguments -> Int
argsNLeaves SimulateArguments
a),
Process -> [Char]
reportProcess (SimulateArguments -> Process
argsProcess SimulateArguments
a),
[Char]
"Perform sub-sampling: " forall a. [a] -> [a] -> [a]
++ [Char]
ssStr,
[Char]
"Summary statistics only: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (SimulateArguments -> Bool
argsSumStat SimulateArguments
a)
]
where
ssStr :: [Char]
ssStr = case SimulateArguments -> Maybe Double
argsSubSample SimulateArguments
a of
Maybe Double
Nothing -> [Char]
"No"
Just Double
p -> [Char]
"Yes, with probability " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Double
p
simulateArguments :: Parser SimulateArguments
simulateArguments :: Parser SimulateArguments
simulateArguments =
Int
-> Int
-> Process
-> Maybe Double
-> Bool
-> SeedOpt
-> SimulateArguments
SimulateArguments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
nTreeOpt
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
nLeavesOpt
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Process
process
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Double)
subSampleOpt
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
sumStatOpt
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SeedOpt
seedOpt
nTreeOpt :: Parser Int
nTreeOpt :: Parser Int
nTreeOpt =
forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"nTrees"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"INT"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Number of trees"
nLeavesOpt :: Parser Int
nLeavesOpt :: Parser Int
nLeavesOpt =
forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"nLeaves"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"INT"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Number of leaves per tree"
lambdaOpt :: Parser Double
lambdaOpt :: Parser Double
lambdaOpt =
forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"lambda"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DOUBLE"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Birth rate lambda"
muOpt :: Parser Double
muOpt :: Parser Double
muOpt =
forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"mu"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DOUBLE"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Death rate mu"
rhoOpt :: Parser Double
rhoOpt :: Parser Double
rhoOpt =
forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"rho"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DOUBLE"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Sampling probability rho"
mrca :: Parser TimeSpec
mrca :: Parser TimeSpec
mrca =
Double -> TimeSpec
Mrca
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option
forall a. Read a => ReadM a
auto
( forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"mrca"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DOUBLE"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Condition on height of most recent common ancestor"
)
origin :: Parser TimeSpec
origin :: Parser TimeSpec
origin =
Double -> TimeSpec
Origin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option
forall a. Read a => ReadM a
auto
( forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"origin"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DOUBLE"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Condition on height of origin"
)
timeSpec :: Parser TimeSpec
timeSpec :: Parser TimeSpec
timeSpec = forall a. a -> Maybe a -> a
fromMaybe TimeSpec
Random forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser TimeSpec
mrca forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TimeSpec
origin)
birthDeath :: Parser Process
birthDeath :: Parser Process
birthDeath = Double -> Double -> Maybe Double -> TimeSpec -> Process
BirthDeath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
lambdaOpt forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
muOpt forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Double
rhoOpt forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeSpec
timeSpec
coalescent :: Parser Process
coalescent :: Parser Process
coalescent = forall (f :: * -> *) a. Applicative f => a -> f a
pure Process
Coalescent
process :: Parser Process
process :: Parser Process
process =
forall a. Mod CommandFields a -> Parser a
hsubparser forall a b. (a -> b) -> a -> b
$
( forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command
[Char]
"birthdeath"
( forall a. Parser a -> InfoMod a -> ParserInfo a
info
Parser Process
birthDeath
( forall a. [Char] -> InfoMod a
progDesc [Char]
"Birth and death process"
forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> InfoMod a
footer [Char]
"Height: If no tree height is given, the heights will be randomly drawn from the expected distribution given the number of leaves, the birth and the death rate assuming a uniform prior."
)
)
forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command
[Char]
"coalescent"
(forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Process
coalescent (forall a. [Char] -> InfoMod a
progDesc [Char]
"Coalescent process"))
)
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"PROCESS"
forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> Mod CommandFields a
commandGroup [Char]
"Available processes:"
subSampleOpt :: Parser (Maybe Double)
subSampleOpt :: Parser (Maybe Double)
subSampleOpt =
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$
forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long
[Char]
"sub-sample"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DOUBLE"
forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Perform sub-sampling; see below."
sumStatOpt :: Parser Bool
sumStatOpt :: Parser Bool
sumStatOpt =
Mod FlagFields Bool -> Parser Bool
switch forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"summary-statistics"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help
[Char]
"For each branch, print length and number of children"
simulateFooter :: [String]
=
[ [Char]
"See, for example, 'tlynx simulate birthdeath --help'.",
[Char]
"Sub-sample with probability p:\n 1. Simulate one big tree with n'=round(n/p), n'>=n, leaves;\n 2. Randomly sample sub trees with n leaves.\n (With p=1.0, the same tree is reported over and over again.)"
]