{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
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
data DistanceMeasure
=
Symmetric
|
IncompatibleSplit Support
|
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"
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
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
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
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"
distanceFooter :: [String]
=
[ 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."
]