{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} module Experimenter.Result.Type where import Experimenter.Availability import Experimenter.Experiment import Experimenter.Input import Experimenter.Measure import Experimenter.Models import Experimenter.Parameter import Experimenter.Setting import Control.DeepSeq import Control.Lens import qualified Data.Text as T import Data.Time import System.Random.MWC phaseFromResultDataKey :: ResultDataKey -> Phase phaseFromResultDataKey ResultDataPrep{} = PreparationPhase phaseFromResultDataKey ResultDataWarmUp{} = WarmUpPhase phaseFromResultDataKey ResultDataRep{} = EvaluationPhase data ResultDataKey = ResultDataPrep !(Key PrepResultData) | ResultDataWarmUp !(Key WarmUpResultData) | ResultDataRep !(Key RepResultData) deriving (Eq, Ord, Show) instance NFData ResultDataKey where rnf (ResultDataPrep !_) = () rnf (ResultDataWarmUp !_) = () rnf (ResultDataRep !_) = () data ResultData a = ResultData { _resultDataKey :: !ResultDataKey , _startTime :: !UTCTime , _endTime :: !(Maybe UTCTime) , _startRandGen :: !GenIO , _endRandGen :: !(Maybe GenIO) , _inputValues :: !(AvailabilityList (ExpM a) (Input a)) , _results :: !(AvailabilityList (ExpM a) Measure) , _startState :: !(Availability (ExpM a) a) , _endState :: !(Availability (ExpM a) (Maybe a)) -- ^ state at end of run , _startInputState :: !(InputState a) , _endInputState :: !(Maybe (InputState a)) } makeLenses ''ResultData instance (ExperimentDef a) => NFData (ResultData a) where rnf (ResultData !k st end !_ !_ !inpVal !res _ endSt !_ !_) = rnf k `seq` rnf st `seq` rnf end `seq` rnf inpVal `seq` rnf res `seq` rnf endSt -- `seq` rnf stSt data ReplicationResult a = ReplicationResult { _replicationResultKey :: !(Key RepResult) , _replicationNumber :: !Int , _warmUpResults :: !(Maybe (ResultData a)) , _evalResults :: !(Maybe (ResultData a)) } makeLenses ''ReplicationResult instance (ExperimentDef a) => NFData (ReplicationResult a) where rnf (ReplicationResult !_ nr wm ev) = rnf nr `seq` rnf1 wm `seq` rnf1 ev data ExperimentResult a = ExperimentResult { _experimentResultKey :: !(Key ExpResult) , _repetitionNumber :: !Int , _preparationResults :: !(Maybe (ResultData a)) , _evaluationResults :: ![ReplicationResult a] } makeLenses ''ExperimentResult instance (ExperimentDef a) => NFData (ExperimentResult a) where rnf (ExperimentResult !_ nr prep ev) = rnf nr `seq` rnf1 prep `seq` rnf1 ev data Experiment a = Experiment { _experimentKey :: !(Key Exp) , _experimentNumber :: !Int , _experimentStartTime :: !UTCTime , _experimentEndTime :: !(Maybe UTCTime) , _parameterSetup :: ![ParameterSetting a] , _experimentResults :: ![ExperimentResult a] } makeLenses ''Experiment instance (ExperimentDef a) => NFData (Experiment a) where rnf (Experiment !_ nr stT endT setup res) = rnf nr `seq` rnf stT `seq` rnf1 endT `seq` rnf1 setup `seq` rnf1 res data Experiments a = Experiments { _experimentsKey :: !(Key Exps) , _experimentsName :: !T.Text , _experimentsStartTime :: !UTCTime , _experimentsEndTime :: !(Maybe UTCTime) , _experimentsSetup :: !ExpsSetup , _experimentsParameters :: ![ParameterSetup a] , _experimentsInfoParameters :: ![ExperimentInfoParameter] , _experimentsInitialState :: !a -- ^ state at period 0 , _experimentsInitialInputState :: !(InputState a) , _experiments :: ![Experiment a] } makeLenses ''Experiments instance (ExperimentDef a) => NFData (Experiments a) where rnf (Experiments !_ name ~stT !endT !_ !param !infoParams !initSt !initInp exps) = rnf name `seq` rnf stT `seq` rnf endT `seq` map rwhnf param `seq` rnf1 infoParams `seq` rnf initSt `seq` rnf initInp `seq` rnf1 exps -- instance Serialize GenIO where -- put g = put (show g) -- get = do -- gTxt <- get -- return (read gTxt)