packages feed

srtree-2.0.1.2: apps/tinygp/Main.hs

module Main (main) where

import GP ( HyperParams(HP), fitnessMV, evolution, printFinal )
import Data.SRTree
import System.Random ( getStdGen )
import Control.Monad.State.Strict ( evalStateT )
import Data.SRTree.Datasets ( loadDataset ) 
import Options.Applicative
import Data.Massiv.Array 
import Util
import Algorithm.SRTree.Likelihoods

-- Data type to store command line arguments
data Args = Args
  { dataset   :: String,
    _testData :: String,
    popSize   :: Int,
    gens      :: Int,
    _maxSize  :: Int,
    pc        :: Double,
    pm        :: Double,
    _nonterminals :: String,
    _nTournament  :: Int,
    _distribution :: Distribution
  }
  deriving (Show)


-- parser of command line arguments
opt :: Parser Args
opt = Args
   <$> strOption
       ( long "dataset"
       <> short 'd'
       <> metavar "INPUT-FILE"
       <> help "CSV dataset." )
   <*> strOption
       ( long "test"
       <> value ""
       <> metavar "INPUT-FILE"
       <> help "CSV dataset." )
   <*> option auto
       ( long "population"
       <> short 'p'
       <> metavar "POP-SIZE"
       <> showDefault
       <> value 100
       <> help "Population size." )
   <*> option auto
      ( long "generations"
      <> short 'g'
      <> metavar "GENS"
      <> showDefault
      <> value 100
      <> help "Number of generations." )
   <*> option auto
      ( long "max-size"
      <> metavar "SIZE"
      <> showDefault
      <> value 20
      <> help "maximum expression size." )
   <*> option auto
      ( long "probCx"
      <> metavar "PC"
      <> showDefault
      <> value 0.9
      <> help "Crossover probability." )
   <*> option auto
      ( long "probMut"
      <> metavar "PM"
      <> showDefault
      <> value 0.3
      <> help "Mutation probability." )
   <*> strOption
       ( long "non-terminals"
       <> value "Add,Sub,Mul,Div,PowerAbs,Recip"
       <> showDefault
       <> help "set of non-terminals to use in the search."
       )
   <*> option auto
       ( long "tournament-size"
       <> value 2
       <> showDefault
       <> help "tournament size."
       )
   <*> option auto
       ( long "distribution"
       <> value MSE
       <> showDefault
       <> help "distribution of the data.")

nonterms = [Right (+), Right (-), Right (*), Right (/), Right (\l r -> Fix $ Bin PowerAbs l r), Left recip, Left log, Left exp, Left (\t -> Fix $ Uni SqrtAbs t)]

main :: IO ()
main = do
  args <- execParser opts
  g <- getStdGen
  --(x, y, _) <- loadTrainingOnly (dataset args) True
  --(x_test, y_test, _) <- loadTrainingOnly (_testData args) True

  let datasets = words (dataset args)
  dataTrains <- Prelude.mapM (flip loadTrainingOnly True) datasets -- load all datasets
  dataTests  <- if null (_testData args)
                  then pure dataTrains
                  else Prelude.mapM (flip loadTrainingOnly True) $ words (_testData args)

  let hp = HP 3 10 (_maxSize args) (popSize args) (_nTournament args) (pc args) (pm args) terms (parseNonTerms $ _nonterminals args)
      (Sz2 _ nFeats) = size . getX $ head dataTrains
      terms = [var ix | ix <- [0 .. nFeats-1]] <> [param ix | ix <- [0 .. 5]]
  best <- evalStateT (evolution (gens args) hp (fitnessMV (_distribution args) dataTrains)) g
  printFinal (_distribution args) best dataTrains dataTests
  where
    opts = info (opt <**> helper)
            ( fullDesc <> progDesc "Very simple example of GP using SRTree."
           <> header "tinyGP - a very simple example of GP using SRTRee." )