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

-- |
-- Module      :  TLynx.Simulate.Options
-- Description :  Argument parser for seq-ana
-- Copyright   :  2021 Dominik Schrempf
-- 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.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

-- | Process to be used for simulation.
data Process
  = BirthDeath
      { -- | Birth rate.
        Process -> Double
bdLambda :: Double,
        -- | Death rate.
        Process -> Double
bdMu :: Double,
        -- | Sampling rate.
        Process -> Maybe Double
bdRho :: Maybe Double,
        -- | Condition on height?
        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"

-- | 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 Double
argsSubSample :: Maybe Double,
    -- | Only print summary statistics?
    SimulateArguments -> Bool
argsSumStat :: Bool,
    -- | Seed of NRG, random if 'Nothing'.
    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

-- | Print useful information about the provided arguments.
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

-- | Command line parser.
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"

-- 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 :: [[Char]]
simulateFooter =
  [ [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.)"
  ]