<commit_before>------------------------------------------------------------------------
-- |
-- Module      :  ALife.Creatur.Wain.UIVector.Prediction.Experiment
-- Copyright   :  (c) <NAME> 2012-2015
-- License     :  BSD-style
-- Maintainer  :  <EMAIL>
-- Stability   :  experimental
-- Portability :  portable
--
-- A data mining agent, designed for the Créatúr framework.
--
------------------------------------------------------------------------
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE Rank2Types #-}
module ALife.Creatur.Wain.UIVector.Prediction.Experiment
  (
    PatternWain,
    randomPatternWain,
    run,
    startRound,
    finishRound,
    schemaQuality,
    printStats,
    versionInfo,
    idealPopControlDeltaE -- exported for testing only
  ) where

import ALife.Creatur (agentId, isAlive, programVersion)
import ALife.Creatur.Persistent (getPS, putPS)
import ALife.Creatur.Task (checkPopSize, requestShutdown)
import qualified ALife.Creatur.Wain as W
import ALife.Creatur.Wain.Brain (makeBrain, predictor, classifier)
import ALife.Creatur.Wain.Checkpoint (enforceAll)
import qualified ALife.Creatur.Wain.Classifier as Cl
import ALife.Creatur.Wain.Muser (makeMuser)
import qualified ALife.Creatur.Wain.Predictor as P
import ALife.Creatur.Wain.GeneticSOM (RandomLearningParams(..),
  randomLearningFunction, schemaQuality, modelMap, numModels)
import ALife.Creatur.Wain.PlusMinusOne (PM1Double, pm1ToDouble)
import ALife.Creatur.Wain.PersistentStatistics (updateStats, readStats,
  clearStats)
import ALife.Creatur.Wain.UIVector.Prediction.Action (Action(..), predict,
  numActions)
import ALife.Creatur.Wain.UIVector.Prediction.DataSource (endOfData,
  nextVector)
import ALife.Creatur.Wain.UIVector.Tweaker (PatternTweaker(..))
import qualified ALife.Creatur.Wain.UIVector.Prediction.Universe as U
import ALife.Creatur.Wain.Pretty (pretty)
import ALife.Creatur.Wain.Raw (raw)
import ALife.Creatur.Wain.Response (Response, action, outcomes)
import qualified ALife.Creatur.Wain.Statistics as Stats
import ALife.Creatur.Wain.Statistics (summarise)
import qualified ALife.Creatur.Wain.UIVector.Wain as UW
import ALife.Creatur.Wain.UnitInterval (UIDouble, uiToDouble,
  doubleToUI)
import ALife.Creatur.Wain.Util (unitInterval, enforceRange, inRange)
import ALife.Creatur.Wain.Weights (makeWeights)
import Control.Conditional (whenM)
import Control.Lens hiding (universe)
import Control.Monad (when, unless)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Random (Rand, RandomGen, getRandom, getRandomR,
  getRandomRs, getRandoms, evalRandIO)
import Control.Monad.State.Lazy (StateT, execStateT, get, put)
import Data.List (intercalate, minimumBy)
import Data.Map (toList)
import Data.Ord (comparing)
import Data.Version (showVersion)
import Data.Word (Word64)
import Paths_exp_uivector_prediction_wains (version)
import System.Directory (createDirectoryIfMissing)
import System.FilePath (dropFileName)
import Text.Printf (printf)

versionInfo :: String
versionInfo
  = "exp-prediction-wains-" ++ showVersion version
      ++ ", compiled with " ++ UW.packageVersion
      ++ ", " ++ W.packageVersion
      ++ ", " ++ ALife.Creatur.programVersion

type PatternWain = W.Wain [UIDouble] PatternTweaker  Action

randomPatternWain
  :: RandomGen r
    => String -> U.Universe PatternWain -> Word64
      -> Rand r PatternWain
randomPatternWain wName u classifierSize = do
  let k = view U.uVectorLength u
  let fcp = RandomLearningParams
              { _r0Range = view U.uPredictorR0Range u,
                _rfRange = view U.uPredictorRfRange u,
                _tfRange = view U.uPredictorTfRange u }
  fc <- randomLearningFunction fcp
  classifierThreshold <- getRandomR (view U.uClassifierThresholdRange u)
  ws <- (makeWeights . take k) <$> getRandoms
  let c = Cl.buildClassifier fc classifierSize classifierThreshold
            (PatternTweaker ws)
  let fdp = RandomLearningParams
              { _r0Range = view U.uPredictorR0Range u,
                _rfRange = view U.uPredictorRfRange u,
                _tfRange = view U.uPredictorTfRange u }
  fd <- randomLearningFunction fdp
  predictorThreshold <- getRandomR (view U.uPredictorThresholdRange u)
  let predictorSize = classifierSize * fromIntegral numActions
  let dr = P.buildPredictor fd predictorSize predictorThreshold
  hw <- (makeWeights . take 4) <$> getRandomRs unitInterval
  dOut <- take 4 <$> getRandomRs (view U.uDefaultOutcomeRange u)
  dp <- getRandomR $ view U.uDepthRange u
  let mr = makeMuser dOut dp
  t <- getRandom
  s <- getRandomR (view U.uStrictnessRange u)
  ios <- take 4 <$> getRandomRs (view U.uImprintOutcomeRange u)
  rds <- take 4 <$> getRandomRs (view U.uReinforcementDeltasRange u)
  let (Right wBrain) = makeBrain c mr dr hw t s ios rds
  wDevotion <- getRandomR . view U.uDevotionRange $ u
  wAgeOfMaturity <- getRandomR . view U.uMaturityRange $ u
  let wPassionDelta = 0
  let wBoredomDelta = 0
  let wAppearance = replicate k $ doubleToUI 0
  return $ W.buildWainAndGenerateGenome wName wAppearance wBrain
    wDevotion wAgeOfMaturity wPassionDelta wBoredomDelta

data Summary = Summary
  {
    _rPopSize :: Int,
    _rVectorNovelty :: UIDouble,
    _rVectorAdjustedNovelty :: Int,
    _rPredDeltaE :: Double,
    _rMetabolismDeltaE :: Double,
    _rPopControlDeltaE :: Double,
    _rMatingDeltaE :: Double,
    _rOldAgeDeltaE :: Double,
    _rOtherMatingDeltaE :: Double,
    _rNetDeltaE :: Double,
    _rChildNetDeltaE :: Double,
    _rPredictedValue :: UIDouble,
    _rActualValue :: UIDouble,
    _rValuePredictionErr :: Double,
    _rRewardPredictionErr :: Double,
    _rRewardCount :: Int,<commit_msg>stop when end of data reached<commit_after>------------------------------------------------------------------------
-- |
-- Module      :  ALife.Creatur.Wain.UIVector.Prediction.Experiment
-- Copyright   :  (c) <NAME> 2012-2015
-- License     :  BSD-style
-- Maintainer  :  <EMAIL>
-- Stability   :  experimental
-- Portability :  portable
--
-- A data mining agent, designed for the Créatúr framework.
--
------------------------------------------------------------------------
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE Rank2Types #-}
module ALife.Creatur.Wain.UIVector.Prediction.Experiment
  (
    PatternWain,
    randomPatternWain,
    run,
    startRound,
    finishRound,
    schemaQuality,
    printStats,
    versionInfo,
    idealPopControlDeltaE -- exported for testing only
  ) where

import ALife.Creatur (agentId, isAlive, programVersion)
import ALife.Creatur.Persistent (getPS, putPS)
import ALife.Creatur.Task (checkPopSize, requestShutdown)
import qualified ALife.Creatur.Wain as W
import ALife.Creatur.Wain.Brain (makeBrain, predictor, classifier)
import ALife.Creatur.Wain.Checkpoint (enforceAll)
import qualified ALife.Creatur.Wain.Classifier as Cl
import ALife.Creatur.Wain.Muser (makeMuser)
import qualified ALife.Creatur.Wain.Predictor as P
import ALife.Creatur.Wain.GeneticSOM (RandomLearningParams(..),
  randomLearningFunction, schemaQuality, modelMap, numModels)
import ALife.Creatur.Wain.PlusMinusOne (PM1Double, pm1ToDouble)
import ALife.Creatur.Wain.PersistentStatistics (updateStats, readStats,
  clearStats)
import ALife.Creatur.Wain.UIVector.Prediction.Action (Action(..), predict,
  numActions)
import ALife.Creatur.Wain.UIVector.Prediction.DataSource (endOfData,
  nextVector)
import ALife.Creatur.Wain.UIVector.Tweaker (PatternTweaker(..))
import qualified ALife.Creatur.Wain.UIVector.Prediction.Universe as U
import ALife.Creatur.Wain.Pretty (pretty)
import ALife.Creatur.Wain.Raw (raw)
import ALife.Creatur.Wain.Response (Response, action, outcomes)
import qualified ALife.Creatur.Wain.Statistics as Stats
import ALife.Creatur.Wain.Statistics (summarise)
import qualified ALife.Creatur.Wain.UIVector.Wain as UW
import ALife.Creatur.Wain.UnitInterval (UIDouble, uiToDouble,
  doubleToUI)
import ALife.Creatur.Wain.Util (unitInterval, enforceRange, inRange)
import ALife.Creatur.Wain.Weights (makeWeights)
import Control.Conditional (whenM)
import Control.Lens hiding (universe)
import Control.Monad (when, unless)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Random (Rand, RandomGen, getRandom, getRandomR,
  getRandomRs, getRandoms, evalRandIO)
import Control.Monad.State.Lazy (StateT, execStateT, get, put)
import Data.List (intercalate, minimumBy)
import Data.Map (toList)
import Data.Ord (comparing)
import Data.Version (showVersion)
import Data.Word (Word64)
import Paths_exp_uivector_prediction_wains (version)
import System.Directory (createDirectoryIfMissing)
import System.FilePath (dropFileName)
import Text.Printf (printf)

versionInfo :: String
versionInfo
  = "exp-prediction-wains-" ++ showVersion version
      ++ ", compiled with " ++ UW.packageVersion
      ++ ", " ++ W.packageVersion
      ++ ", " ++ ALife.Creatur.programVersion

type PatternWain = W.Wain [UIDouble] PatternTweaker  Action

randomPatternWain
  :: RandomGen r
    => String -> U.Universe PatternWain -> Word64
      -> Rand r PatternWain
randomPatternWain wName u classifierSize = do
  let k = view U.uVectorLength u
  let fcp = RandomLearningParams
              { _r0Range = view U.uPredictorR0Range u,
                _rfRange = view U.uPredictorRfRange u,
                _tfRange = view U.uPredictorTfRange u }
  fc <- randomLearningFunction fcp
  classifierThreshold <- getRandomR (view U.uClassifierThresholdRange u)
  ws <- (makeWeights . take k) <$> getRandoms
  let c = Cl.buildClassifier fc classifierSize classifierThreshold
            (PatternTweaker ws)
  let fdp = RandomLearningParams
              { _r0Range = view U.uPredictorR0Range u,
                _rfRange = view U.uPredictorRfRange u,
                _tfRange = view U.uPredictorTfRange u }
  fd <- randomLearningFunction fdp
  predictorThreshold <- getRandomR (view U.uPredictorThresholdRange u)
  let predictorSize = classifierSize * fromIntegral numActions
  let dr = P.buildPredictor fd predictorSize predictorThreshold
  hw <- (makeWeights . take 4) <$> getRandomRs unitInterval
  dOut <- take 4 <$> getRandomRs (view U.uDefaultOutcomeRange u)
  dp <- getRandomR $ view U.uDepthRange u
  let (Right mr) = makeMuser dOut dp
  t <- getRandom
  s <- getRandomR (view U.uStrictnessRange u)
  ios <- take 4 <$> getRandomRs (view U.uImprintOutcomeRange u)
  rds <- take 4 <$> getRandomRs (view U.uReinforcementDeltasRange u)
  let (Right wBrain) = makeBrain c mr dr hw t s ios rds
  wDevotion <- getRandomR . view U.uDevotionRange $ u
  wAgeOfMaturity <- getRandomR . view U.uMaturityRange $ u
  let wPassionDelta = 0
  let wBoredomDelta = 0
  let wAppearance = replicate k $ doubleToUI 0
  return $ W.buildWainAndGenerateGenome wName wAppearance wBrain
    wDevotion wAgeOfMaturity wPassionDelta wBoredomDelta

data Summary = Summary
  {
    _rPopSize :: Int,
    _rVectorNovelty :: UIDouble,
    _rVectorAdjustedNovelty :: Int,
    _rPredDeltaE :: Double,
    _rMetabolismDeltaE :: Double,
    _rPopControlDeltaE :: Double,
    _rMatingDeltaE :: Double,
    _rOldAgeDeltaE :: Double,
    _rOtherMatingDeltaE :: Double,
    _rNetDeltaE :: Double,
    _rChildNetDeltaE :: Double,
    _rPredictedValue :: UIDouble,
    _rActualValue :: UIDouble,
    _rValuePredictionErr :: Double,
    _rRewardPredictionErr :: Double,
    _rRewardCount :: Int,
{'fraction_non_alphanumeric': 0.11565217391304349, 'fraction_numerical': 0.004521739130434782, 'mean_word_length': 3.617021276595745, 'pattern_counts': {'":': 0, '<': 45, '<?xml version=': 0, '>': 25, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1788262', 'n_tokens_mistral': 3881, 'n_tokens_neox': 3712, 'n_words': 895}