{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  TLynx.Distance.Options
-- Description :  Options of tree-dist
-- Copyright   :  2021 Dominik Schrempf
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Thu Aug 29 13:02:22 2019.
module TLynx.Distance.Options
  ( DistanceArguments (..),
    DistanceMeasure (..),
    distanceArguments,
    distanceFooter,
  )
where

import Data.Aeson
import qualified Data.Attoparsec.ByteString.Char8 as AC
import qualified Data.ByteString.Char8 as BS
import ELynx.Tools.Reproduction
import ELynx.Tree (Support (..), toSupportUnsafe)
import GHC.Generics
import Options.Applicative
import TLynx.Parsers
import Text.Printf

-- | Supported distance measures.
data DistanceMeasure
  = -- | Symmetric distance.
    Symmetric
  | -- | Incompatible split distance; collapse nodes
    -- with branch support below given value.
    IncompatibleSplit Support
  | -- | Branch score distance.
    BranchScore
  deriving (DistanceMeasure -> DistanceMeasure -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DistanceMeasure -> DistanceMeasure -> Bool
$c/= :: DistanceMeasure -> DistanceMeasure -> Bool
== :: DistanceMeasure -> DistanceMeasure -> Bool
$c== :: DistanceMeasure -> DistanceMeasure -> Bool
Eq, forall x. Rep DistanceMeasure x -> DistanceMeasure
forall x. DistanceMeasure -> Rep DistanceMeasure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DistanceMeasure x -> DistanceMeasure
$cfrom :: forall x. DistanceMeasure -> Rep DistanceMeasure x
Generic)

instance FromJSON DistanceMeasure

instance ToJSON DistanceMeasure

instance Show DistanceMeasure where
  show :: DistanceMeasure -> FilePath
show DistanceMeasure
Symmetric = FilePath
"Symmetric"
  show (IncompatibleSplit Support
c) = FilePath
"Incompatible Split (" forall a. [a] -> [a] -> [a]
++ forall r. PrintfType r => FilePath -> r
printf FilePath
"%.2f" (Support -> Double
fromSupport Support
c) forall a. [a] -> [a] -> [a]
++ FilePath
")"
  show DistanceMeasure
BranchScore = FilePath
"Branch Score"

-- | Arguments needed to compute distance measures.
data DistanceArguments = DistanceArguments
  { DistanceArguments -> DistanceMeasure
argsDistance :: DistanceMeasure,
    DistanceArguments -> Bool
argsNormalize :: Bool,
    DistanceArguments -> Bool
argsIntersect :: Bool,
    DistanceArguments -> Bool
argsSummaryStatistics :: Bool,
    DistanceArguments -> Maybe FilePath
argsMasterTreeFile :: Maybe FilePath,
    DistanceArguments -> NewickFormat
argsNewickFormat :: NewickFormat,
    DistanceArguments -> [FilePath]
argsInFiles :: [FilePath]
  }
  deriving (DistanceArguments -> DistanceArguments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DistanceArguments -> DistanceArguments -> Bool
$c/= :: DistanceArguments -> DistanceArguments -> Bool
== :: DistanceArguments -> DistanceArguments -> Bool
$c== :: DistanceArguments -> DistanceArguments -> Bool
Eq, Int -> DistanceArguments -> ShowS
[DistanceArguments] -> ShowS
DistanceArguments -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DistanceArguments] -> ShowS
$cshowList :: [DistanceArguments] -> ShowS
show :: DistanceArguments -> FilePath
$cshow :: DistanceArguments -> FilePath
showsPrec :: Int -> DistanceArguments -> ShowS
$cshowsPrec :: Int -> DistanceArguments -> ShowS
Show, forall x. Rep DistanceArguments x -> DistanceArguments
forall x. DistanceArguments -> Rep DistanceArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DistanceArguments x -> DistanceArguments
$cfrom :: forall x. DistanceArguments -> Rep DistanceArguments x
Generic)

instance Reproducible DistanceArguments where
  inFiles :: DistanceArguments -> [FilePath]
inFiles DistanceArguments
a = case DistanceArguments -> Maybe FilePath
argsMasterTreeFile DistanceArguments
a of
    Maybe FilePath
Nothing -> DistanceArguments -> [FilePath]
argsInFiles DistanceArguments
a
    Just FilePath
f -> FilePath
f forall a. a -> [a] -> [a]
: DistanceArguments -> [FilePath]
argsInFiles DistanceArguments
a
  outSuffixes :: DistanceArguments -> [FilePath]
outSuffixes DistanceArguments
_ = [FilePath
".out"]
  getSeed :: DistanceArguments -> Maybe SeedOpt
getSeed DistanceArguments
_ = forall a. Maybe a
Nothing
  setSeed :: DistanceArguments -> SeedOpt -> DistanceArguments
setSeed = forall a b. a -> b -> a
const
  parser :: Parser DistanceArguments
parser = Parser DistanceArguments
distanceArguments
  cmdName :: FilePath
cmdName = FilePath
"distance"
  cmdDsc :: [FilePath]
cmdDsc = [FilePath
"Compute distances between many phylogenetic trees."]
  cmdFtr :: [FilePath]
cmdFtr = [FilePath]
distanceFooter

instance FromJSON DistanceArguments

instance ToJSON DistanceArguments

-- | COmmand line parser.
distanceArguments :: Parser DistanceArguments
distanceArguments :: Parser DistanceArguments
distanceArguments =
  DistanceMeasure
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> NewickFormat
-> [FilePath]
-> DistanceArguments
DistanceArguments
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DistanceMeasure
distanceOpt
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
normalizeSwitch
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
intersectSwitch
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
summaryStatisticsSwitch
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
masterTreeFile
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NewickFormat
newickFormat
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser FilePath
inFilesArg

masterTreeFile :: Parser (Maybe FilePath)
masterTreeFile :: Parser (Maybe FilePath)
masterTreeFile =
  forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$
    forall s. IsString s => Mod OptionFields s -> Parser s
strOption forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"master-tree-file"
        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 => FilePath -> Mod f a
metavar FilePath
"MASTER-TREE-File"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Compare all trees to the tree in the master tree file."
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
action FilePath
"file"

inFilesArg :: Parser FilePath
inFilesArg :: Parser FilePath
inFilesArg =
  forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"INPUT-FILES"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help
        FilePath
"Read tree(s) from INPUT-FILES; if more files are given, one tree is expected per file"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
action FilePath
"file"

symmetric :: AC.Parser DistanceMeasure
symmetric :: Parser DistanceMeasure
symmetric = do
  ByteString
_ <- ByteString -> Parser ByteString
AC.string ByteString
"symmetric"
  ()
_ <- forall t. Chunk t => Parser t ()
AC.endOfInput
  forall (f :: * -> *) a. Applicative f => a -> f a
pure DistanceMeasure
Symmetric

incompatibleSplit :: AC.Parser DistanceMeasure
incompatibleSplit :: Parser DistanceMeasure
incompatibleSplit = do
  ByteString
_ <- ByteString -> Parser ByteString
AC.string ByteString
"incompatible-split"
  Char
_ <- Char -> Parser Char
AC.char Char
'['
  Double
f <- Parser Double
AC.double
  Char
_ <- Char -> Parser Char
AC.char Char
']'
  ()
_ <- forall t. Chunk t => Parser t ()
AC.endOfInput
  if (Double
0 forall a. Ord a => a -> a -> Bool
<= Double
f) Bool -> Bool -> Bool
&& (Double
f forall a. Ord a => a -> a -> Bool
<= Double
1)
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Support -> DistanceMeasure
IncompatibleSplit forall a b. (a -> b) -> a -> b
$ Double -> Support
toSupportUnsafe Double
f
    else forall a. HasCallStack => FilePath -> a
error FilePath
"Branch support has to be in [0, 1]."

branchScore :: AC.Parser DistanceMeasure
branchScore :: Parser DistanceMeasure
branchScore = do
  ByteString
_ <- ByteString -> Parser ByteString
AC.string ByteString
"branch-score"
  ()
_ <- forall t. Chunk t => Parser t ()
AC.endOfInput
  forall (f :: * -> *) a. Applicative f => a -> f a
pure DistanceMeasure
BranchScore

-- Try first the normalized one, since the normal branch score
-- parser also succeeds in this case.
distanceParser :: AC.Parser DistanceMeasure
distanceParser :: Parser DistanceMeasure
distanceParser = Parser DistanceMeasure
symmetric forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser DistanceMeasure
incompatibleSplit forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser DistanceMeasure
branchScore

-- See 'eitherReader', but for an attoparsec parser.
eitherReadA :: AC.Parser a -> ReadM a
eitherReadA :: forall a. Parser a -> ReadM a
eitherReadA Parser a
p = forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$ \FilePath
input -> forall a. Parser a -> ByteString -> Either FilePath a
AC.parseOnly Parser a
p (FilePath -> ByteString
BS.pack FilePath
input)

distanceOpt :: Parser DistanceMeasure
distanceOpt :: Parser DistanceMeasure
distanceOpt =
  forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall a. Parser a -> ReadM a
eitherReadA Parser DistanceMeasure
distanceParser) forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"distance"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"MEASURE"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help
        FilePath
"Type of distance to calculate (available distance measures are listed below)"

summaryStatisticsSwitch :: Parser Bool
summaryStatisticsSwitch :: Parser Bool
summaryStatisticsSwitch =
  Mod FlagFields Bool -> Parser Bool
switch forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"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 (f :: * -> *) a. FilePath -> Mod f a
help
        FilePath
"Report summary statistics only"

normalizeSwitch :: Parser Bool
normalizeSwitch :: Parser Bool
normalizeSwitch =
  Mod FlagFields Bool -> Parser Bool
switch forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"normalize"
      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. FilePath -> Mod f a
help
        FilePath
"Normalize trees before distance calculation; only affect distances depending on branch lengths"

intersectSwitch :: Parser Bool
intersectSwitch :: Parser Bool
intersectSwitch =
  Mod FlagFields Bool -> Parser Bool
switch forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"intersect"
      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. FilePath -> Mod f a
help
        FilePath
"Compare intersections; i.e., before comparison, drop leaves that are not present in the other tree"

-- | Information about provided distance types.
distanceFooter :: [String]
distanceFooter :: [FilePath]
distanceFooter =
  [ FilePath
"Distance measures:",
    FilePath
"  symmetric                Symmetric distance (Robinson-Foulds distance).",
    FilePath
"  incompatible-split[VAL]  Incompatible split distance. Collapse branches with (normalized)",
    FilePath
"                           support less than 0.0<=VAL<=1.0 before distance calculation;",
    FilePath
"                           if, let's say, VAL>0.7, only well supported differences contribute",
    FilePath
"                           to the total distance.",
    FilePath
"  branch-score             Branch score distance."
  ]