{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- Module      :  TLynx.Simulate.Options
-- Description :  Argument parser for seq-ana
-- Copyright   :  (c) Dominik Schrempf 2020
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Fri May  3 11:51:07 2019.
module TLynx.Simulate.Options
  ( Process (..),
    SimulateArguments (..),
    simulateArguments,
    reportSimulateArguments,
  )
where

import Data.List
import Data.Maybe
import ELynx.Tools hiding (Random)
import ELynx.Tree.Simulate.PointProcess (TimeSpec (..))
import Options.Applicative

deriving instance Eq TimeSpec

deriving instance Generic TimeSpec

instance Show TimeSpec where
  show :: TimeSpec -> String
show TimeSpec
Random = String
"Random"
  show (Origin Time
o) = String
"Condition on height of origin: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Time -> String
forall a. Show a => a -> String
show Time
o
  show (Mrca Time
m) = String
"Condition on height of MRCA: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Time -> String
forall a. Show a => a -> String
show Time
m

instance FromJSON TimeSpec

instance ToJSON TimeSpec

-- | Process to be used for simulation.
data Process
  = BirthDeath
      { -- | Birth rate.
        Process -> Time
bdLambda :: Double,
        -- | Death rate.
        Process -> Time
bdMu :: Double,
        -- | Sampling rate.
        Process -> Maybe Time
bdRho :: Maybe Double,
        -- | Condition on height?
        Process -> TimeSpec
bdHeight :: TimeSpec
      }
  | Coalescent
  deriving (Process -> Process -> Bool
(Process -> Process -> Bool)
-> (Process -> Process -> Bool) -> Eq Process
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 -> String
(Int -> Process -> ShowS)
-> (Process -> String) -> ([Process] -> ShowS) -> Show Process
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Process] -> ShowS
$cshowList :: [Process] -> ShowS
show :: Process -> String
$cshow :: Process -> String
showsPrec :: Int -> Process -> ShowS
$cshowsPrec :: Int -> Process -> ShowS
Show, (forall x. Process -> Rep Process x)
-> (forall x. Rep Process x -> Process) -> Generic Process
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 -> String
reportProcess (BirthDeath Time
l Time
m Maybe Time
mr TimeSpec
ts) =
  String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate
    String
"\n"
    [ String
"Model: Birth and death process",
      String
"  Birth rate: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Time -> String
forall a. Show a => a -> String
show Time
l,
      String
"  Death rate: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Time -> String
forall a. Show a => a -> String
show Time
m,
      String
"  Sampling probability: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> (Time -> String) -> Maybe Time -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"1.0" Time -> String
forall a. Show a => a -> String
show Maybe Time
mr,
      String
"  Height specification: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TimeSpec -> String
forall a. Show a => a -> String
show TimeSpec
ts
    ]
reportProcess Process
Coalescent = String
"Model: Coalescent process"

-- | Arguments need to simulate phylogenetic trees using birth and death processes.
data SimulateArguments = SimulateArguments
  { -- | Simulated trees.
    SimulateArguments -> Int
argsNTrees :: Int,
    -- | Number of leaves.
    SimulateArguments -> Int
argsNLeaves :: Int,
    -- | Process.
    SimulateArguments -> Process
argsProcess :: Process,
    -- | Perform sub-sampling with given probability.
    SimulateArguments -> Maybe Time
argsSubSample :: Maybe Double,
    -- | Only print summary statistics?
    SimulateArguments -> Bool
argsSumStat :: Bool,
    -- | Seed of NRG, random if 'Nothing'.
    SimulateArguments -> Seed
argsSeed :: Seed
  }
  deriving (SimulateArguments -> SimulateArguments -> Bool
(SimulateArguments -> SimulateArguments -> Bool)
-> (SimulateArguments -> SimulateArguments -> Bool)
-> Eq SimulateArguments
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 -> String
(Int -> SimulateArguments -> ShowS)
-> (SimulateArguments -> String)
-> ([SimulateArguments] -> ShowS)
-> Show SimulateArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimulateArguments] -> ShowS
$cshowList :: [SimulateArguments] -> ShowS
show :: SimulateArguments -> String
$cshow :: SimulateArguments -> String
showsPrec :: Int -> SimulateArguments -> ShowS
$cshowsPrec :: Int -> SimulateArguments -> ShowS
Show, (forall x. SimulateArguments -> Rep SimulateArguments x)
-> (forall x. Rep SimulateArguments x -> SimulateArguments)
-> Generic SimulateArguments
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 -> [String]
inFiles SimulateArguments
_ = []
  outSuffixes :: SimulateArguments -> [String]
outSuffixes SimulateArguments
_ = [String
".tree"]
  getSeed :: SimulateArguments -> Maybe Seed
getSeed = Seed -> Maybe Seed
forall a. a -> Maybe a
Just (Seed -> Maybe Seed)
-> (SimulateArguments -> Seed) -> SimulateArguments -> Maybe Seed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimulateArguments -> Seed
argsSeed
  setSeed :: SimulateArguments -> Vector Word32 -> SimulateArguments
setSeed SimulateArguments
a Vector Word32
s = SimulateArguments
a {argsSeed :: Seed
argsSeed = Vector Word32 -> Seed
Fixed Vector Word32
s}
  parser :: Parser SimulateArguments
parser = Parser SimulateArguments
simulateArguments
  cmdName :: String
cmdName = String
"simulate"
  cmdDsc :: [String]
cmdDsc = [String
"Simulate phylogenetic trees using a birth and death or coalescent process."]
  cmdFtr :: [String]
cmdFtr = [String]
simulateFooter

instance FromJSON SimulateArguments

instance ToJSON SimulateArguments

-- | Print useful information about the provided arguments.
reportSimulateArguments :: SimulateArguments -> String
reportSimulateArguments :: SimulateArguments -> String
reportSimulateArguments SimulateArguments
a =
  String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate
    String
"\n"
    [ String
"Number of simulated trees: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (SimulateArguments -> Int
argsNTrees SimulateArguments
a),
      String
"Number of leaves per tree: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (SimulateArguments -> Int
argsNLeaves SimulateArguments
a),
      Process -> String
reportProcess (SimulateArguments -> Process
argsProcess SimulateArguments
a),
      String
"Perform sub-sampling: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ssStr,
      String
"Summary statistics only: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show (SimulateArguments -> Bool
argsSumStat SimulateArguments
a)
    ]
  where
    ssStr :: String
ssStr = case SimulateArguments -> Maybe Time
argsSubSample SimulateArguments
a of
      Maybe Time
Nothing -> String
"No"
      Just Time
p -> String
"Yes, with probability " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Time -> String
forall a. Show a => a -> String
show Time
p

-- | Command line parser.
simulateArguments :: Parser SimulateArguments
simulateArguments :: Parser SimulateArguments
simulateArguments =
  Int
-> Int
-> Process
-> Maybe Time
-> Bool
-> Seed
-> SimulateArguments
SimulateArguments
    (Int
 -> Int
 -> Process
 -> Maybe Time
 -> Bool
 -> Seed
 -> SimulateArguments)
-> Parser Int
-> Parser
     (Int -> Process -> Maybe Time -> Bool -> Seed -> SimulateArguments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
nTreeOpt
    Parser
  (Int -> Process -> Maybe Time -> Bool -> Seed -> SimulateArguments)
-> Parser Int
-> Parser
     (Process -> Maybe Time -> Bool -> Seed -> SimulateArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
nLeavesOpt
    Parser (Process -> Maybe Time -> Bool -> Seed -> SimulateArguments)
-> Parser Process
-> Parser (Maybe Time -> Bool -> Seed -> SimulateArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Process
process
    Parser (Maybe Time -> Bool -> Seed -> SimulateArguments)
-> Parser (Maybe Time)
-> Parser (Bool -> Seed -> SimulateArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Time)
subSampleOpt
    Parser (Bool -> Seed -> SimulateArguments)
-> Parser Bool -> Parser (Seed -> SimulateArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
sumStatOpt
    Parser (Seed -> SimulateArguments)
-> Parser Seed -> Parser SimulateArguments
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Seed
seedOpt

nTreeOpt :: Parser Int
nTreeOpt :: Parser Int
nTreeOpt =
  ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
    String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"nTrees"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't'
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Number of trees"

nLeavesOpt :: Parser Int
nLeavesOpt :: Parser Int
nLeavesOpt =
  ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
    String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"nLeaves"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n'
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Number of leaves per tree"

lambdaOpt :: Parser Double
lambdaOpt :: Parser Time
lambdaOpt =
  ReadM Time -> Mod OptionFields Time -> Parser Time
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Time
forall a. Read a => ReadM a
auto (Mod OptionFields Time -> Parser Time)
-> Mod OptionFields Time -> Parser Time
forall a b. (a -> b) -> a -> b
$
    String -> Mod OptionFields Time
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"lambda"
      Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Time
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l'
      Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Time
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DOUBLE"
      Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Time
forall (f :: * -> *) a. String -> Mod f a
help String
"Birth rate lambda"

muOpt :: Parser Double
muOpt :: Parser Time
muOpt =
  ReadM Time -> Mod OptionFields Time -> Parser Time
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Time
forall a. Read a => ReadM a
auto (Mod OptionFields Time -> Parser Time)
-> Mod OptionFields Time -> Parser Time
forall a b. (a -> b) -> a -> b
$
    String -> Mod OptionFields Time
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"mu"
      Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Time
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm'
      Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Time
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DOUBLE"
      Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Time
forall (f :: * -> *) a. String -> Mod f a
help String
"Death rate mu"

rhoOpt :: Parser Double
rhoOpt :: Parser Time
rhoOpt =
  ReadM Time -> Mod OptionFields Time -> Parser Time
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Time
forall a. Read a => ReadM a
auto (Mod OptionFields Time -> Parser Time)
-> Mod OptionFields Time -> Parser Time
forall a b. (a -> b) -> a -> b
$
    String -> Mod OptionFields Time
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"rho"
      Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Time
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r'
      Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Time
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DOUBLE"
      Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Time
forall (f :: * -> *) a. String -> Mod f a
help String
"Sampling probability rho"

mrca :: Parser TimeSpec
mrca :: Parser TimeSpec
mrca =
  Time -> TimeSpec
Mrca
    (Time -> TimeSpec) -> Parser Time -> Parser TimeSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Time -> Mod OptionFields Time -> Parser Time
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM Time
forall a. Read a => ReadM a
auto
      ( String -> Mod OptionFields Time
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"mrca"
          Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Time
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DOUBLE"
          Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Time
forall (f :: * -> *) a. String -> Mod f a
help String
"Condition on height of most recent common ancestor"
      )

origin :: Parser TimeSpec
origin :: Parser TimeSpec
origin =
  Time -> TimeSpec
Origin
    (Time -> TimeSpec) -> Parser Time -> Parser TimeSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Time -> Mod OptionFields Time -> Parser Time
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM Time
forall a. Read a => ReadM a
auto
      ( String -> Mod OptionFields Time
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"origin"
          Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Time
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DOUBLE"
          Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Time
forall (f :: * -> *) a. String -> Mod f a
help String
"Condition on height of origin"
      )

timeSpec :: Parser TimeSpec
timeSpec :: Parser TimeSpec
timeSpec = TimeSpec -> Maybe TimeSpec -> TimeSpec
forall a. a -> Maybe a -> a
fromMaybe TimeSpec
Random (Maybe TimeSpec -> TimeSpec)
-> Parser (Maybe TimeSpec) -> Parser TimeSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TimeSpec -> Parser (Maybe TimeSpec)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser TimeSpec
mrca Parser TimeSpec -> Parser TimeSpec -> Parser TimeSpec
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TimeSpec
origin)

birthDeath :: Parser Process
birthDeath :: Parser Process
birthDeath = Time -> Time -> Maybe Time -> TimeSpec -> Process
BirthDeath (Time -> Time -> Maybe Time -> TimeSpec -> Process)
-> Parser Time
-> Parser (Time -> Maybe Time -> TimeSpec -> Process)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Time
lambdaOpt Parser (Time -> Maybe Time -> TimeSpec -> Process)
-> Parser Time -> Parser (Maybe Time -> TimeSpec -> Process)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Time
muOpt Parser (Maybe Time -> TimeSpec -> Process)
-> Parser (Maybe Time) -> Parser (TimeSpec -> Process)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Time -> Parser (Maybe Time)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Time
rhoOpt Parser (TimeSpec -> Process) -> Parser TimeSpec -> Parser Process
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeSpec
timeSpec

coalescent :: Parser Process
coalescent :: Parser Process
coalescent = Process -> Parser Process
forall (f :: * -> *) a. Applicative f => a -> f a
pure Process
Coalescent

process :: Parser Process
process :: Parser Process
process =
  Mod CommandFields Process -> Parser Process
forall a. Mod CommandFields a -> Parser a
hsubparser (Mod CommandFields Process -> Parser Process)
-> Mod CommandFields Process -> Parser Process
forall a b. (a -> b) -> a -> b
$
    ( String -> ParserInfo Process -> Mod CommandFields Process
forall a. String -> ParserInfo a -> Mod CommandFields a
command
        String
"birthdeath"
        ( Parser Process -> InfoMod Process -> ParserInfo Process
forall a. Parser a -> InfoMod a -> ParserInfo a
info
            Parser Process
birthDeath
            ( String -> InfoMod Process
forall a. String -> InfoMod a
progDesc String
"Birth and death process"
                InfoMod Process -> InfoMod Process -> InfoMod Process
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Process
forall a. String -> InfoMod a
footer String
"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."
            )
        )
        Mod CommandFields Process
-> Mod CommandFields Process -> Mod CommandFields Process
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Process -> Mod CommandFields Process
forall a. String -> ParserInfo a -> Mod CommandFields a
command
          String
"coalescent"
          (Parser Process -> InfoMod Process -> ParserInfo Process
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Process
coalescent (String -> InfoMod Process
forall a. String -> InfoMod a
progDesc String
"Coalescent process"))
    )
      Mod CommandFields Process
-> Mod CommandFields Process -> Mod CommandFields Process
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields Process
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PROCESS"
      Mod CommandFields Process
-> Mod CommandFields Process -> Mod CommandFields Process
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields Process
forall a. String -> Mod CommandFields a
commandGroup String
"Available processes:"

subSampleOpt :: Parser (Maybe Double)
subSampleOpt :: Parser (Maybe Time)
subSampleOpt =
  Parser Time -> Parser (Maybe Time)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Time -> Parser (Maybe Time))
-> Parser Time -> Parser (Maybe Time)
forall a b. (a -> b) -> a -> b
$
    ReadM Time -> Mod OptionFields Time -> Parser Time
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Time
forall a. Read a => ReadM a
auto (Mod OptionFields Time -> Parser Time)
-> Mod OptionFields Time -> Parser Time
forall a b. (a -> b) -> a -> b
$
      String -> Mod OptionFields Time
forall (f :: * -> *) a. HasName f => String -> Mod f a
long
        String
"sub-sample"
        Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Time
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u'
        Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Time
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DOUBLE"
        Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Time
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields Time
-> Mod OptionFields Time -> Mod OptionFields Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Time
forall (f :: * -> *) a. String -> Mod f a
help String
"Perform sub-sampling; see below."

sumStatOpt :: Parser Bool
sumStatOpt :: Parser Bool
sumStatOpt =
  Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"summary-statistics" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall a (f :: * -> *). Show a => Mod f a
showDefault
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help
        String
"For each branch, print length and number of children"

-- citation :: String
-- citation =
--   "Gernhard, T. (2008). The conditioned reconstructed process. Journal of Theoretical Biology, 253(4), 769–778. http://doi.org/10.1016/j.jtbi.2008.04.005"

-- | And a footer.
simulateFooter :: [String]
simulateFooter :: [String]
simulateFooter =
  [ String
"See, for example, 'tlynx simulate birthdeath --help'.",
    String
"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.)"
  ]