{-# language OverloadedStrings #-}
{-|
Module      : MachineLearning.Utils.Config
Description : TIR expression data structures
Copyright   : (c) Fabricio Olivetti de Franca, 2022
License     : GPL-3
Maintainer  : fabricio.olivetti@gmail.com
Stability   : experimental
Portability : POSIX

Configuration parsing and report generation.
-}
module MachineLearning.Utils.Config where

import Data.Ini.Config         (IniParser, readable, parseIniFile, section, fieldOf)
import Data.Text        hiding (map)
import Data.Text.IO            (readFile)
import Prelude          hiding (readFile)

-- import Constraints.Shape       (Shape(..), Domains)
import MachineLearning.Model.Measure           (Measure, toMeasure)
import Data.SRTree                    (Function(..))
import Algorithm.ShapeConstraint

allFunctions :: [Function]
allFunctions = [Function
Id .. ]

-- | Task can be Regression, Classification and One-vs-All Classification
data Task = Regression | RegressionNL Int | Classification Int | ClassMult Int
         deriving (Task -> Task -> Bool
(Task -> Task -> Bool) -> (Task -> Task -> Bool) -> Eq Task
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Task -> Task -> Bool
$c/= :: Task -> Task -> Bool
== :: Task -> Task -> Bool
$c== :: Task -> Task -> Bool
Eq, ReadPrec [Task]
ReadPrec Task
Int -> ReadS Task
ReadS [Task]
(Int -> ReadS Task)
-> ReadS [Task] -> ReadPrec Task -> ReadPrec [Task] -> Read Task
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Task]
$creadListPrec :: ReadPrec [Task]
readPrec :: ReadPrec Task
$creadPrec :: ReadPrec Task
readList :: ReadS [Task]
$creadList :: ReadS [Task]
readsPrec :: Int -> ReadS Task
$creadsPrec :: Int -> ReadS Task
Read, Int -> Task -> ShowS
[Task] -> ShowS
Task -> String
(Int -> Task -> ShowS)
-> (Task -> String) -> ([Task] -> ShowS) -> Show Task
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Task] -> ShowS
$cshowList :: [Task] -> ShowS
show :: Task -> String
$cshow :: Task -> String
showsPrec :: Int -> Task -> ShowS
$cshowsPrec :: Int -> Task -> ShowS
Show)

-- | Current algorithm implementation are traditional Evolutionary (GPTIR) and 
-- Feasible-Infeasible two-population for shape-constraint (SCTIR).
data Algorithm = GPTIR | SCTIR deriving (Algorithm -> Algorithm -> Bool
(Algorithm -> Algorithm -> Bool)
-> (Algorithm -> Algorithm -> Bool) -> Eq Algorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Algorithm -> Algorithm -> Bool
$c/= :: Algorithm -> Algorithm -> Bool
== :: Algorithm -> Algorithm -> Bool
$c== :: Algorithm -> Algorithm -> Bool
Eq, ReadPrec [Algorithm]
ReadPrec Algorithm
Int -> ReadS Algorithm
ReadS [Algorithm]
(Int -> ReadS Algorithm)
-> ReadS [Algorithm]
-> ReadPrec Algorithm
-> ReadPrec [Algorithm]
-> Read Algorithm
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Algorithm]
$creadListPrec :: ReadPrec [Algorithm]
readPrec :: ReadPrec Algorithm
$creadPrec :: ReadPrec Algorithm
readList :: ReadS [Algorithm]
$creadList :: ReadS [Algorithm]
readsPrec :: Int -> ReadS Algorithm
$creadsPrec :: Int -> ReadS Algorithm
Read, Int -> Algorithm -> ShowS
[Algorithm] -> ShowS
Algorithm -> String
(Int -> Algorithm -> ShowS)
-> (Algorithm -> String)
-> ([Algorithm] -> ShowS)
-> Show Algorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Algorithm] -> ShowS
$cshowList :: [Algorithm] -> ShowS
show :: Algorithm -> String
$cshow :: Algorithm -> String
showsPrec :: Int -> Algorithm -> ShowS
$cshowsPrec :: Int -> Algorithm -> ShowS
Show)

-- | Type of penalty function
data Penalty = NoPenalty | Len Double | Shape Double deriving (Int -> Penalty -> ShowS
[Penalty] -> ShowS
Penalty -> String
(Int -> Penalty -> ShowS)
-> (Penalty -> String) -> ([Penalty] -> ShowS) -> Show Penalty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Penalty] -> ShowS
$cshowList :: [Penalty] -> ShowS
show :: Penalty -> String
$cshow :: Penalty -> String
showsPrec :: Int -> Penalty -> ShowS
$cshowsPrec :: Int -> Penalty -> ShowS
Show, ReadPrec [Penalty]
ReadPrec Penalty
Int -> ReadS Penalty
ReadS [Penalty]
(Int -> ReadS Penalty)
-> ReadS [Penalty]
-> ReadPrec Penalty
-> ReadPrec [Penalty]
-> Read Penalty
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Penalty]
$creadListPrec :: ReadPrec [Penalty]
readPrec :: ReadPrec Penalty
$creadPrec :: ReadPrec Penalty
readList :: ReadS [Penalty]
$creadList :: ReadS [Penalty]
readsPrec :: Int -> ReadS Penalty
$creadsPrec :: Int -> ReadS Penalty
Read)

-- | Output configuration 
data Output = Screen | PartialLog String | EvoLog String deriving (ReadPrec [Output]
ReadPrec Output
Int -> ReadS Output
ReadS [Output]
(Int -> ReadS Output)
-> ReadS [Output]
-> ReadPrec Output
-> ReadPrec [Output]
-> Read Output
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Output]
$creadListPrec :: ReadPrec [Output]
readPrec :: ReadPrec Output
$creadPrec :: ReadPrec Output
readList :: ReadS [Output]
$creadList :: ReadS [Output]
readsPrec :: Int -> ReadS Output
$creadsPrec :: Int -> ReadS Output
Read, Int -> Output -> ShowS
[Output] -> ShowS
Output -> String
(Int -> Output -> ShowS)
-> (Output -> String) -> ([Output] -> ShowS) -> Show Output
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Output] -> ShowS
$cshowList :: [Output] -> ShowS
show :: Output -> String
$cshow :: Output -> String
showsPrec :: Int -> Output -> ShowS
$cshowsPrec :: Int -> Output -> ShowS
Show)

-- | Configuration data
data Config = Conf { Config -> MutationCfg
_mutationCfg   :: MutationCfg
                   , Config -> IOCfg
_ioCfg         :: IOCfg
                   , Config -> AlgorithmCfg
_algorithmCfg  :: AlgorithmCfg
                   , Config -> ConstraintCfg
_constraintCfg :: ConstraintCfg
                   } deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)
                   
-- | Mutation config 
data MutationCfg = MutCfg { MutationCfg -> (Int, Int)
_kRange :: (Int, Int)
                          , MutationCfg -> [Function]
_funs   :: [Function]
                          , MutationCfg -> [Function]
_yfuns  :: [Function]
                          , MutationCfg -> [Int]
_vars   :: [Int]
                          , MutationCfg -> Int
_budget :: Int
                          } deriving (Int -> MutationCfg -> ShowS
[MutationCfg] -> ShowS
MutationCfg -> String
(Int -> MutationCfg -> ShowS)
-> (MutationCfg -> String)
-> ([MutationCfg] -> ShowS)
-> Show MutationCfg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MutationCfg] -> ShowS
$cshowList :: [MutationCfg] -> ShowS
show :: MutationCfg -> String
$cshow :: MutationCfg -> String
showsPrec :: Int -> MutationCfg -> ShowS
$cshowsPrec :: Int -> MutationCfg -> ShowS
Show, ReadPrec [MutationCfg]
ReadPrec MutationCfg
Int -> ReadS MutationCfg
ReadS [MutationCfg]
(Int -> ReadS MutationCfg)
-> ReadS [MutationCfg]
-> ReadPrec MutationCfg
-> ReadPrec [MutationCfg]
-> Read MutationCfg
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MutationCfg]
$creadListPrec :: ReadPrec [MutationCfg]
readPrec :: ReadPrec MutationCfg
$creadPrec :: ReadPrec MutationCfg
readList :: ReadS [MutationCfg]
$creadList :: ReadS [MutationCfg]
readsPrec :: Int -> ReadS MutationCfg
$creadsPrec :: Int -> ReadS MutationCfg
Read)

dfltMutCfg :: MutationCfg
dfltMutCfg :: MutationCfg
dfltMutCfg = (Int, Int)
-> [Function] -> [Function] -> [Int] -> Int -> MutationCfg
MutCfg (-Int
5, Int
5) [Function]
allFunctions [Function]
allFunctions [] Int
0

-- | Dataset and logging configs
data IOCfg = IOCfg { IOCfg -> String
_trainFilename :: String
                   , IOCfg -> String
_testFilename  :: String
                   , IOCfg -> Output
_logType       :: Output
                   } deriving (Int -> IOCfg -> ShowS
[IOCfg] -> ShowS
IOCfg -> String
(Int -> IOCfg -> ShowS)
-> (IOCfg -> String) -> ([IOCfg] -> ShowS) -> Show IOCfg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IOCfg] -> ShowS
$cshowList :: [IOCfg] -> ShowS
show :: IOCfg -> String
$cshow :: IOCfg -> String
showsPrec :: Int -> IOCfg -> ShowS
$cshowsPrec :: Int -> IOCfg -> ShowS
Show, ReadPrec [IOCfg]
ReadPrec IOCfg
Int -> ReadS IOCfg
ReadS [IOCfg]
(Int -> ReadS IOCfg)
-> ReadS [IOCfg]
-> ReadPrec IOCfg
-> ReadPrec [IOCfg]
-> Read IOCfg
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IOCfg]
$creadListPrec :: ReadPrec [IOCfg]
readPrec :: ReadPrec IOCfg
$creadPrec :: ReadPrec IOCfg
readList :: ReadS [IOCfg]
$creadList :: ReadS [IOCfg]
readsPrec :: Int -> ReadS IOCfg
$creadsPrec :: Int -> ReadS IOCfg
Read)
                   
-- | Algorithm configuration
data AlgorithmCfg = AlgCfg { AlgorithmCfg -> Algorithm
_algorithm :: Algorithm
                           , AlgorithmCfg -> Task
_task      :: Task
                           , AlgorithmCfg -> Int
_gens      :: Int
                           , AlgorithmCfg -> Int
_nPop      :: Int
                           , AlgorithmCfg -> Double
_pm        :: Double
                           , AlgorithmCfg -> Double
_pc        :: Double
                           , AlgorithmCfg -> Maybe Int
_seed      :: Maybe Int
                           , AlgorithmCfg -> [Measure]
_measures  :: [Measure]
                           } deriving (Int -> AlgorithmCfg -> ShowS
[AlgorithmCfg] -> ShowS
AlgorithmCfg -> String
(Int -> AlgorithmCfg -> ShowS)
-> (AlgorithmCfg -> String)
-> ([AlgorithmCfg] -> ShowS)
-> Show AlgorithmCfg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlgorithmCfg] -> ShowS
$cshowList :: [AlgorithmCfg] -> ShowS
show :: AlgorithmCfg -> String
$cshow :: AlgorithmCfg -> String
showsPrec :: Int -> AlgorithmCfg -> ShowS
$cshowsPrec :: Int -> AlgorithmCfg -> ShowS
Show)

dfltAlgCfg :: AlgorithmCfg
dfltAlgCfg :: AlgorithmCfg
dfltAlgCfg = Algorithm
-> Task
-> Int
-> Int
-> Double
-> Double
-> Maybe Int
-> [Measure]
-> AlgorithmCfg
AlgCfg Algorithm
GPTIR Task
Regression Int
100 Int
100 Double
0.25 Double
1.0 Maybe Int
forall a. Maybe a
Nothing [String -> Measure
toMeasure String
"RMSE"]

data ConstraintCfg = CnsCfg { ConstraintCfg -> Penalty
_penaltyType :: Penalty
                            , ConstraintCfg -> [Shape]
_shapes      :: [Shape] 
                            , ConstraintCfg -> [(Double, Double)]
_domains     :: [(Double, Double)]
                            , ConstraintCfg -> Maybe Evaluator
_evaluator   :: Maybe Evaluator 
                            } deriving (Int -> ConstraintCfg -> ShowS
[ConstraintCfg] -> ShowS
ConstraintCfg -> String
(Int -> ConstraintCfg -> ShowS)
-> (ConstraintCfg -> String)
-> ([ConstraintCfg] -> ShowS)
-> Show ConstraintCfg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstraintCfg] -> ShowS
$cshowList :: [ConstraintCfg] -> ShowS
show :: ConstraintCfg -> String
$cshow :: ConstraintCfg -> String
showsPrec :: Int -> ConstraintCfg -> ShowS
$cshowsPrec :: Int -> ConstraintCfg -> ShowS
Show, ReadPrec [ConstraintCfg]
ReadPrec ConstraintCfg
Int -> ReadS ConstraintCfg
ReadS [ConstraintCfg]
(Int -> ReadS ConstraintCfg)
-> ReadS [ConstraintCfg]
-> ReadPrec ConstraintCfg
-> ReadPrec [ConstraintCfg]
-> Read ConstraintCfg
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConstraintCfg]
$creadListPrec :: ReadPrec [ConstraintCfg]
readPrec :: ReadPrec ConstraintCfg
$creadPrec :: ReadPrec ConstraintCfg
readList :: ReadS [ConstraintCfg]
$creadList :: ReadS [ConstraintCfg]
readsPrec :: Int -> ReadS ConstraintCfg
$creadsPrec :: Int -> ReadS ConstraintCfg
Read)

dfltCnstrCfg :: ConstraintCfg
dfltCnstrCfg :: ConstraintCfg
dfltCnstrCfg = Penalty
-> [Shape]
-> [(Double, Double)]
-> Maybe Evaluator
-> ConstraintCfg
CnsCfg Penalty
NoPenalty [] [] Maybe Evaluator
forall a. Maybe a
Nothing

getLogType :: Config -> Output
getLogType :: Config -> Output
getLogType = IOCfg -> Output
_logType (IOCfg -> Output) -> (Config -> IOCfg) -> Config -> Output
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> IOCfg
_ioCfg

getSeed :: Config -> Maybe Int
getSeed :: Config -> Maybe Int
getSeed = AlgorithmCfg -> Maybe Int
_seed (AlgorithmCfg -> Maybe Int)
-> (Config -> AlgorithmCfg) -> Config -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> AlgorithmCfg
_algorithmCfg

getTask :: Config -> Task
getTask :: Config -> Task
getTask = AlgorithmCfg -> Task
_task (AlgorithmCfg -> Task)
-> (Config -> AlgorithmCfg) -> Config -> Task
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> AlgorithmCfg
_algorithmCfg

getNPop :: Config -> Int
getNPop :: Config -> Int
getNPop = AlgorithmCfg -> Int
_nPop (AlgorithmCfg -> Int) -> (Config -> AlgorithmCfg) -> Config -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> AlgorithmCfg
_algorithmCfg

getNGens :: Config -> Int
getNGens :: Config -> Int
getNGens = AlgorithmCfg -> Int
_gens (AlgorithmCfg -> Int) -> (Config -> AlgorithmCfg) -> Config -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> AlgorithmCfg
_algorithmCfg

getTrainName, getTestName :: Config -> String
getTrainName :: Config -> String
getTrainName = IOCfg -> String
_trainFilename (IOCfg -> String) -> (Config -> IOCfg) -> Config -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> IOCfg
_ioCfg
getTestName :: Config -> String
getTestName  = IOCfg -> String
_testFilename  (IOCfg -> String) -> (Config -> IOCfg) -> Config -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> IOCfg
_ioCfg

getDomains :: Config -> [(Double, Double)]
getDomains :: Config -> [(Double, Double)]
getDomains = ConstraintCfg -> [(Double, Double)]
_domains (ConstraintCfg -> [(Double, Double)])
-> (Config -> ConstraintCfg) -> Config -> [(Double, Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> ConstraintCfg
_constraintCfg

getImage :: Config -> Maybe (Double, Double)
getImage :: Config -> Maybe (Double, Double)
getImage = Maybe (Double, Double) -> Config -> Maybe (Double, Double)
forall a b. a -> b -> a
const Maybe (Double, Double)
forall a. Maybe a
Nothing -- findImg . _shapes . _constraintCfg
--  where
--    findImg []                 = Nothing
--    findImg (Image (lo, hi):_) = Just (lo, hi)
--    findImg (_:xs)             = findImg xs

getMeasures :: Config -> [Measure]
getMeasures :: Config -> [Measure]
getMeasures = AlgorithmCfg -> [Measure]
_measures (AlgorithmCfg -> [Measure])
-> (Config -> AlgorithmCfg) -> Config -> [Measure]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> AlgorithmCfg
_algorithmCfg

getShapes :: Config -> [Shape]
getShapes :: Config -> [Shape]
getShapes = ConstraintCfg -> [Shape]
_shapes (ConstraintCfg -> [Shape])
-> (Config -> ConstraintCfg) -> Config -> [Shape]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> ConstraintCfg
_constraintCfg

getPenalty :: Config -> Penalty
getPenalty :: Config -> Penalty
getPenalty = ConstraintCfg -> Penalty
_penaltyType (ConstraintCfg -> Penalty)
-> (Config -> ConstraintCfg) -> Config -> Penalty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> ConstraintCfg
_constraintCfg

readConfig :: String -> IO Config
readConfig :: String -> IO Config
readConfig String
fname = do Text
content <- String -> IO Text
readFile String
fname
                      case Text -> IniParser Config -> Either String Config
forall a. Text -> IniParser a -> Either String a
parseIniFile Text
content IniParser Config
parseConfig of
                        Left String
e    -> String -> IO Config
forall a. HasCallStack => String -> a
error String
e
                        Right Config
cfg -> Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
cfg

-- | Read the config file and run the algorithm.
parseConfig :: IniParser Config
parseConfig :: IniParser Config
parseConfig = do
  MutationCfg
mutCfg <- Text -> SectionParser MutationCfg -> IniParser MutationCfg
forall a. Text -> SectionParser a -> IniParser a
section Text
"Mutation" (SectionParser MutationCfg -> IniParser MutationCfg)
-> SectionParser MutationCfg -> IniParser MutationCfg
forall a b. (a -> b) -> a -> b
$ do
    (Int, Int)
krange  <- Text
-> (Text -> Either String (Int, Int)) -> SectionParser (Int, Int)
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"krange" Text -> Either String (Int, Int)
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    [Function]
tfuncs  <- Text
-> (Text -> Either String [Function]) -> SectionParser [Function]
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"transfunctions" Text -> Either String [Function]
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    [Function]
ytfuncs <- Text
-> (Text -> Either String [Function]) -> SectionParser [Function]
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"Ytransfunctions" Text -> Either String [Function]
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    MutationCfg -> SectionParser MutationCfg
forall (m :: * -> *) a. Monad m => a -> m a
return (MutationCfg -> SectionParser MutationCfg)
-> MutationCfg -> SectionParser MutationCfg
forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> [Function] -> [Function] -> [Int] -> Int -> MutationCfg
MutCfg (Int, Int)
krange [Function]
tfuncs [Function]
ytfuncs [] Int
0
  IOCfg
ioCfg <- Text -> SectionParser IOCfg -> IniParser IOCfg
forall a. Text -> SectionParser a -> IniParser a
section Text
"IO" (SectionParser IOCfg -> IniParser IOCfg)
-> SectionParser IOCfg -> IniParser IOCfg
forall a b. (a -> b) -> a -> b
$ do
    String
trainname <- Text -> (Text -> Either String String) -> SectionParser String
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"train" Text -> Either String String
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    String
testname  <- Text -> (Text -> Either String String) -> SectionParser String
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"test" Text -> Either String String
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    Output
logg      <- Text -> (Text -> Either String Output) -> SectionParser Output
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"log" Text -> Either String Output
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    IOCfg -> SectionParser IOCfg
forall (m :: * -> *) a. Monad m => a -> m a
return (IOCfg -> SectionParser IOCfg) -> IOCfg -> SectionParser IOCfg
forall a b. (a -> b) -> a -> b
$ String -> String -> Output -> IOCfg
IOCfg String
trainname String
testname Output
logg 
  AlgorithmCfg
algCfg <- Text -> SectionParser AlgorithmCfg -> IniParser AlgorithmCfg
forall a. Text -> SectionParser a -> IniParser a
section Text
"Algorithm" (SectionParser AlgorithmCfg -> IniParser AlgorithmCfg)
-> SectionParser AlgorithmCfg -> IniParser AlgorithmCfg
forall a b. (a -> b) -> a -> b
$ do
    Algorithm
alg  <- Text
-> (Text -> Either String Algorithm) -> SectionParser Algorithm
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"algorithm" Text -> Either String Algorithm
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    Task
task <- Text -> (Text -> Either String Task) -> SectionParser Task
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"task" Text -> Either String Task
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    Int
nGens <- Text -> (Text -> Either String Int) -> SectionParser Int
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"ngens" Text -> Either String Int
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    Int
nPop <- Text -> (Text -> Either String Int) -> SectionParser Int
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"npop" Text -> Either String Int
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    Double
pm <- Text -> (Text -> Either String Double) -> SectionParser Double
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"probmut" Text -> Either String Double
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    Double
pc <- Text -> (Text -> Either String Double) -> SectionParser Double
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"probcx" Text -> Either String Double
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    [String]
perf_mes <- Text -> (Text -> Either String [String]) -> SectionParser [String]
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"measures" Text -> Either String [String]
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    Maybe Int
seed <- Text
-> (Text -> Either String (Maybe Int)) -> SectionParser (Maybe Int)
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"seed" Text -> Either String (Maybe Int)
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    AlgorithmCfg -> SectionParser AlgorithmCfg
forall (m :: * -> *) a. Monad m => a -> m a
return (AlgorithmCfg -> SectionParser AlgorithmCfg)
-> AlgorithmCfg -> SectionParser AlgorithmCfg
forall a b. (a -> b) -> a -> b
$ Algorithm
-> Task
-> Int
-> Int
-> Double
-> Double
-> Maybe Int
-> [Measure]
-> AlgorithmCfg
AlgCfg Algorithm
alg Task
task Int
nGens Int
nPop Double
pm Double
pc Maybe Int
seed ([Measure] -> AlgorithmCfg) -> [Measure] -> AlgorithmCfg
forall a b. (a -> b) -> a -> b
$ (String -> Measure) -> [String] -> [Measure]
forall a b. (a -> b) -> [a] -> [b]
map String -> Measure
toMeasure [String]
perf_mes
  ConstraintCfg
cnsCfg <- Text -> SectionParser ConstraintCfg -> IniParser ConstraintCfg
forall a. Text -> SectionParser a -> IniParser a
section Text
"Constraints" (SectionParser ConstraintCfg -> IniParser ConstraintCfg)
-> SectionParser ConstraintCfg -> IniParser ConstraintCfg
forall a b. (a -> b) -> a -> b
$ do
    Penalty
penalty <- Text -> (Text -> Either String Penalty) -> SectionParser Penalty
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"penalty" Text -> Either String Penalty
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    [Shape]
shapes <- Text -> (Text -> Either String [Shape]) -> SectionParser [Shape]
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"shapes" Text -> Either String [Shape]
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    [(Double, Double)]
domains <- Text
-> (Text -> Either String [(Double, Double)])
-> SectionParser [(Double, Double)]
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"domains" Text -> Either String [(Double, Double)]
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    Maybe Evaluator
evaluator <- Text
-> (Text -> Either String (Maybe Evaluator))
-> SectionParser (Maybe Evaluator)
forall a. Text -> (Text -> Either String a) -> SectionParser a
fieldOf Text
"evaluator" Text -> Either String (Maybe Evaluator)
forall a. (Read a, Typeable a) => Text -> Either String a
readable
    ConstraintCfg -> SectionParser ConstraintCfg
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstraintCfg -> SectionParser ConstraintCfg)
-> ConstraintCfg -> SectionParser ConstraintCfg
forall a b. (a -> b) -> a -> b
$ Penalty
-> [Shape]
-> [(Double, Double)]
-> Maybe Evaluator
-> ConstraintCfg
CnsCfg Penalty
penalty [Shape]
shapes [(Double, Double)]
domains Maybe Evaluator
evaluator 
  Config -> IniParser Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> IniParser Config) -> Config -> IniParser Config
forall a b. (a -> b) -> a -> b
$ MutationCfg -> IOCfg -> AlgorithmCfg -> ConstraintCfg -> Config
Conf MutationCfg
mutCfg IOCfg
ioCfg AlgorithmCfg
algCfg ConstraintCfg
cnsCfg