{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeFamilies        #-}
module Experimenter.Eval.Csv
    ( writeCsvMeasure
    , Smoothing (..)
    , MeasureName
    ) where

import           Conduit                      as C
import           Control.Lens                 hiding (Cons, Over)
import           Control.Monad.Logger
import           Control.Monad.Reader
import           Data.Maybe                   (fromMaybe)
import qualified Data.Text                    as T
import           Data.Time.Clock              (diffUTCTime, getCurrentTime)
import qualified Database.Esqueleto           as E
import           System.Directory
import           System.FilePath.Posix
import           System.IO

import           Experimenter.DatabaseSetting
import           Experimenter.DB
import           Experimenter.Eval.Util
import           Experimenter.Experiment      (Phase (..))
import           Experimenter.Models
import           Experimenter.Result.Type
import           Experimenter.Util


data Smoothing = NoSmoothing | SmoothingMovAvg !Int

type MeasureName = T.Text

writeCsvMeasure :: DatabaseSetting -> Experiments a -> Smoothing -> [MeasureName] -> IO ()
writeCsvMeasure :: forall a.
DatabaseSetting -> Experiments a -> Smoothing -> [Text] -> IO ()
writeCsvMeasure DatabaseSetting
dbSetup Experiments a
exps Smoothing
smoothing [Text]
measures = forall (m1 :: * -> *) a (m :: * -> *).
MonadUnliftIO m1 =>
(m1 a -> m a)
-> DatabaseSetting -> ReaderT SqlBackend (LoggingT m1) a -> m a
runDBWithM forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT DatabaseSetting
dbSetup forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a. Experiments a -> Smoothing -> Text -> DB IO ()
smoothAndWriteFile Experiments a
exps Smoothing
smoothing) [Text]
measures

smoothAndWriteFile :: Experiments a -> Smoothing -> MeasureName -> DB IO ()
smoothAndWriteFile :: forall a. Experiments a -> Smoothing -> Text -> DB IO ()
smoothAndWriteFile Experiments a
exps Smoothing
smoothing Text
measureName = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a.
Experiments a -> Smoothing -> Text -> Experiment a -> DB IO ()
smoothAndWriteFileExp Experiments a
exps Smoothing
smoothing Text
measureName) (Experiments a
exps forall s a. s -> Getting a s a -> a
^. forall a. Lens' (Experiments a) [Experiment a]
experiments)

smoothAndWriteFileExp :: Experiments a -> Smoothing -> MeasureName -> Experiment a -> DB IO ()
smoothAndWriteFileExp :: forall a.
Experiments a -> Smoothing -> Text -> Experiment a -> DB IO ()
smoothAndWriteFileExp Experiments a
exps Smoothing
smoothing Text
measureName Experiment a
exp = do
  $(logDebug) forall a b. (a -> b) -> a -> b
$ Text
"Processing CSV for experiment number " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (Experiment a
exp forall s a. s -> Getting a s a -> a
^. forall a. Lens' (Experiment a) RepetNr
experimentNumber)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (\ExperimentResult a
expRes -> do
       $(logDebug) forall a b. (a -> b) -> a -> b
$ Text
"Processing CSV for experiment repetition number " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (ExperimentResult a
expRes forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ExperimentResult a) RepetNr
repetitionNumber)
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
         (forall a.
Experiments a
-> Text -> Smoothing -> Text -> [ResultData a] -> DB IO ()
smoothAndWriteFileResultData Experiments a
exps (RepetNr -> Phase -> Avg -> Text
namePrefix RepetNr
expNr Phase
PreparationPhase (RepetNr -> Maybe RepetNr -> Avg
None (ExperimentResult a
expRes forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ExperimentResult a) RepetNr
repetitionNumber) forall a. Maybe a
Nothing)) Smoothing
smoothing Text
measureName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return)
         (ExperimentResult a
expRes forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. forall a. Lens' (ExperimentResult a) (Maybe (ResultData a))
preparationResults forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal RepetNr (f a) (f b) a b
traversed)
       -- All experiment evaluations runs
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
         (\(ReplicationResult a
replRes :: ReplicationResult a) -> do
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
              (\(ResultData a
repRes :: ResultData a) ->
                 forall a.
Experiments a
-> Text -> Smoothing -> Text -> [ResultData a] -> DB IO ()
smoothAndWriteFileResultData
                   Experiments a
exps
                   (RepetNr -> Phase -> Avg -> Text
namePrefix RepetNr
expNr Phase
WarmUpPhase (RepetNr -> Maybe RepetNr -> Avg
None (ExperimentResult a
expRes forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ExperimentResult a) RepetNr
repetitionNumber) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ReplicationResult a
replRes forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ReplicationResult a) RepetNr
replicationNumber)))
                   Smoothing
smoothing
                   Text
measureName
                   [ResultData a
repRes])
              (ReplicationResult a
replRes forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. forall a. Lens' (ReplicationResult a) (Maybe (ResultData a))
warmUpResults forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal RepetNr (f a) (f b) a b
traversed)
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
              (\(ResultData a
repRes :: ResultData a) ->
                 forall a.
Experiments a
-> Text -> Smoothing -> Text -> [ResultData a] -> DB IO ()
smoothAndWriteFileResultData
                   Experiments a
exps
                   (RepetNr -> Phase -> Avg -> Text
namePrefix RepetNr
expNr Phase
EvaluationPhase (RepetNr -> Maybe RepetNr -> Avg
None (ExperimentResult a
expRes forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ExperimentResult a) RepetNr
repetitionNumber) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ReplicationResult a
replRes forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ReplicationResult a) RepetNr
replicationNumber)))
                   Smoothing
smoothing
                   Text
measureName
                   [ResultData a
repRes])
              (ReplicationResult a
replRes forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. forall a. Lens' (ReplicationResult a) (Maybe (ResultData a))
evalResults forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal RepetNr (f a) (f b) a b
traversed))
         (ExperimentResult a
expRes forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ExperimentResult a) [ReplicationResult a]
evaluationResults))
    (Experiment a
exp forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal RepetNr (f a) (f b) a b
traversed)
  -- avg over experiments
  -- when (length (exp ^. experimentResults) > 1) $ do
  --   $(logDebug) $ "Processing aggregated CSV for experiment  number " <> tshow (exp ^. experimentNumber)
  --   mapM_
  --     (\expRes -> do
  --         error "Averages over experiment results are currently not supported. Please feel free to submit a merge request."
  --         print expRes
  --         ) (exp ^. experimentResults)
  where
    expNr :: RepetNr
expNr = Experiment a
exp forall s a. s -> Getting a s a -> a
^. forall a. Lens' (Experiment a) RepetNr
experimentNumber


smoothC :: (Monad m) => Smoothing -> C.ConduitT (Int, Double) (Int, Double) m ()
smoothC :: forall (m :: * -> *).
Monad m =>
Smoothing -> ConduitT (RepetNr, Double) (RepetNr, Double) m ()
smoothC Smoothing
NoSmoothing = forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
C.filterC (forall a b. a -> b -> a
const Bool
True)
smoothC (SmoothingMovAvg RepetNr
nr) = (Double, [(RepetNr, Double)])
-> ConduitT (RepetNr, Double) (RepetNr, Double) m ()
process (Double
0, [])
  where
    process :: (Double, [(RepetNr, Double)])
-> ConduitT (RepetNr, Double) (RepetNr, Double) m ()
process inp :: (Double, [(RepetNr, Double)])
inp@(Double
sm, [(RepetNr, Double)]
xs) = do
      Maybe (RepetNr, Double)
mx <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RepetNr, Double)]
xs) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ((Double, [(RepetNr, Double)]) -> (RepetNr, Double)
movAvg (Double, [(RepetNr, Double)])
inp)
      case Maybe (RepetNr, Double)
mx of
        Maybe (RepetNr, Double)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just ((RepetNr, Double)
x :: (Int, Double)) -> do
          let m :: Double
m
                | forall (t :: * -> *) a. Foldable t => t a -> RepetNr
length [(RepetNr, Double)]
xs forall a. Ord a => a -> a -> Bool
< RepetNr
nr = Double
0
                | Bool
otherwise = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [(RepetNr, Double)]
xs
              v :: Double
v = forall a b. (a, b) -> b
snd (RepetNr, Double)
x
          (Double, [(RepetNr, Double)])
-> ConduitT (RepetNr, Double) (RepetNr, Double) m ()
process (Double
sm forall a. Num a => a -> a -> a
+ Double
v forall a. Num a => a -> a -> a
- Double
m, forall a. RepetNr -> [a] -> [a]
take RepetNr
nr ((RepetNr, Double)
x forall a. a -> [a] -> [a]
: [(RepetNr, Double)]
xs))

-- movAvg :: [Measure] -> Measure
-- movAvg [] = error "empty list when makeing movAvg"
-- movAvg xs@(x:_) = set (measureResults.traversed.resultYValue) (Prelude.sum (concatMap (^.. (measureResults.traversed.resultYValue)) xs) / fromIntegral (length xs)) x

movAvg :: (Double, [(Int, Double)]) -> (Int, Double)
movAvg :: (Double, [(RepetNr, Double)]) -> (RepetNr, Double)
movAvg (Double
_,[])   = forall a. HasCallStack => String -> a
error String
"No input for movAvg. Programming error!"
movAvg (Double
sm, [(RepetNr, Double)]
xs) = (forall a b. (a, b) -> a
fst (RepetNr, Double)
x, Double
sm forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> RepetNr
length [(RepetNr, Double)]
xs))
  where x :: (RepetNr, Double)
x = forall a. [a] -> a
last [(RepetNr, Double)]
xs

data Keys = ResultDataPrepKeys ![Key PrepResultData]
          | ResultDataWarmUpKeys ![Key WarmUpResultData]
          | ResultDataRepKeys ![Key RepResultData]

concatKeys :: Keys -> Keys -> Keys
concatKeys :: Keys -> Keys -> Keys
concatKeys (ResultDataPrepKeys [Key PrepResultData]
xs) (ResultDataPrepKeys [Key PrepResultData]
ys) = [Key PrepResultData] -> Keys
ResultDataPrepKeys ([Key PrepResultData]
xs forall a. [a] -> [a] -> [a]
++ [Key PrepResultData]
ys)
concatKeys (ResultDataWarmUpKeys [Key WarmUpResultData]
xs) (ResultDataWarmUpKeys [Key WarmUpResultData]
ys)= [Key WarmUpResultData] -> Keys
ResultDataWarmUpKeys ([Key WarmUpResultData]
xs forall a. [a] -> [a] -> [a]
++ [Key WarmUpResultData]
ys)
concatKeys (ResultDataRepKeys [Key RepResultData]
xs) (ResultDataRepKeys [Key RepResultData]
ys) = [Key RepResultData] -> Keys
ResultDataRepKeys ([Key RepResultData]
xs forall a. [a] -> [a] -> [a]
++ [Key RepResultData]
ys)
concatKeys Keys
_ Keys
_ = forall a. HasCallStack => String -> a
error String
"cannot concat different key types in Csv.hs"

smoothAndWriteFileResultData :: Experiments a -> T.Text -> Smoothing -> MeasureName -> [ResultData a] -> DB IO ()
smoothAndWriteFileResultData :: forall a.
Experiments a
-> Text -> Smoothing -> Text -> [ResultData a] -> DB IO ()
smoothAndWriteFileResultData Experiments a
_ Text
_ Smoothing
_ Text
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
smoothAndWriteFileResultData Experiments a
exps Text
prefix Smoothing
smoothing Text
measureName [ResultData a]
resData = do
  $(logInfo) forall a b. (a -> b) -> a -> b
$ Text
"Processing measure " forall a. Semigroup a => a -> a -> a
<> Text
measureName forall a. Semigroup a => a -> a -> a
<> Text
". Saving data to: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
folder
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
folder
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile String
filePath String
header forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> String -> IO ()
writeFile String
filePathPlotSh String
plotSh
  Handle
fileH <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IOMode -> IO Handle
openFile String
filePath IOMode
AppendMode
  UTCTime
start <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let vals :: ConduitT
  ()
  (Value RepetNr, Value (Maybe Double))
  (ReaderT SqlBackend (LoggingT (ResourceT IO)))
  ()
vals =
        -- fmap (map (fromMaybe 0 . E.unValue)) $
        -- E.select $ -- E.selectSource $
        forall a r backend (m :: * -> *).
(SqlSelect a r, BackendCompatible SqlBackend backend,
 IsPersistBackend backend, PersistQueryRead backend,
 PersistStoreRead backend, PersistUniqueRead backend,
 MonadResource m) =>
SqlQuery a -> ConduitT () r (ReaderT backend m) ()
E.selectSource forall a b. (a -> b) -> a -> b
$
        case forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Keys -> Keys -> Keys
concatKeys [Keys]
keys of
          ResultDataPrepKeys [Key PrepResultData]
xs ->
            forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from forall a b. (a -> b) -> a -> b
$ \(SqlExpr (Entity PrepMeasure)
measure `E.InnerJoin` SqlExpr (Entity PrepResultStep)
result) -> do
              SqlExpr (Value Bool) -> SqlQuery ()
E.on (SqlExpr (Entity PrepMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ PrepMeasureId) => EntityField PrepMeasure typ
PrepMeasureId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity PrepResultStep)
result forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ PrepMeasureId) => EntityField PrepResultStep typ
PrepResultStepMeasure)
              case [Key PrepResultData]
xs of
                [Key PrepResultData
x] -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepMeasure typ
PrepMeasurePrepResultData forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Key PrepResultData
x)
                [Key PrepResultData]
_ -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepMeasure typ
PrepMeasurePrepResultData forall typ.
PersistField typ =>
SqlExpr (Value typ)
-> SqlExpr (ValueList typ) -> SqlExpr (Value Bool)
`E.in_` forall typ. PersistField typ => [typ] -> SqlExpr (ValueList typ)
E.valList [Key PrepResultData]
xs)
              SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepResultStep)
result forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Text) => EntityField PrepResultStep typ
PrepResultStepName forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Text
measureName)
              [SqlExpr OrderBy] -> SqlQuery ()
E.orderBy [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
E.asc (SqlExpr (Entity PrepMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepetNr) => EntityField PrepMeasure typ
PrepMeasurePeriod)]
              forall a. ToSomeValues a => a -> SqlQuery ()
E.groupBy (SqlExpr (Entity PrepMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepetNr) => EntityField PrepMeasure typ
PrepMeasurePeriod)
              forall (m :: * -> *) a. Monad m => a -> m a
return (SqlExpr (Entity PrepMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepetNr) => EntityField PrepMeasure typ
PrepMeasurePeriod, forall a b.
(PersistField a, PersistField b) =>
SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
E.avg_ forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity PrepResultStep)
result forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Double) => EntityField PrepResultStep typ
PrepResultStepYValue)
          ResultDataWarmUpKeys [Key WarmUpResultData]
xs ->
            forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from forall a b. (a -> b) -> a -> b
$ \(SqlExpr (Entity WarmUpMeasure)
measure `E.InnerJoin` SqlExpr (Entity WarmUpResultStep)
result) -> do
              SqlExpr (Value Bool) -> SqlQuery ()
E.on (SqlExpr (Entity WarmUpMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ.
(typ ~ WarmUpMeasureId) =>
EntityField WarmUpMeasure typ
WarmUpMeasureId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity WarmUpResultStep)
result forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ.
(typ ~ WarmUpMeasureId) =>
EntityField WarmUpResultStep typ
WarmUpResultStepMeasure)
              case [Key WarmUpResultData]
xs of
                [Key WarmUpResultData
x] -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpMeasure typ
WarmUpMeasureRepResult forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Key WarmUpResultData
x)
                [Key WarmUpResultData]
_ -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpMeasure typ
WarmUpMeasureRepResult forall typ.
PersistField typ =>
SqlExpr (Value typ)
-> SqlExpr (ValueList typ) -> SqlExpr (Value Bool)
`E.in_` forall typ. PersistField typ => [typ] -> SqlExpr (ValueList typ)
E.valList [Key WarmUpResultData]
xs)
              SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpResultStep)
result forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Text) => EntityField WarmUpResultStep typ
WarmUpResultStepName forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Text
measureName)
              [SqlExpr OrderBy] -> SqlQuery ()
E.orderBy [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
E.asc (SqlExpr (Entity WarmUpMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepetNr) => EntityField WarmUpMeasure typ
WarmUpMeasurePeriod)]
              forall a. ToSomeValues a => a -> SqlQuery ()
E.groupBy (SqlExpr (Entity WarmUpMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepetNr) => EntityField WarmUpMeasure typ
WarmUpMeasurePeriod)
              forall (m :: * -> *) a. Monad m => a -> m a
return (SqlExpr (Entity WarmUpMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepetNr) => EntityField WarmUpMeasure typ
WarmUpMeasurePeriod, forall a b.
(PersistField a, PersistField b) =>
SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
E.avg_ forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity WarmUpResultStep)
result forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Double) => EntityField WarmUpResultStep typ
WarmUpResultStepYValue)
          ResultDataRepKeys [Key RepResultData]
xs ->
            forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from forall a b. (a -> b) -> a -> b
$ \(SqlExpr (Entity RepMeasure)
measure `E.InnerJoin` SqlExpr (Entity RepResultStep)
result) -> do
              SqlExpr (Value Bool) -> SqlQuery ()
E.on (SqlExpr (Entity RepMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepMeasureId) => EntityField RepMeasure typ
RepMeasureId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity RepResultStep)
result forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepMeasureId) => EntityField RepResultStep typ
RepResultStepMeasure)
              case [Key RepResultData]
xs of
                [Key RepResultData
x] -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Key RepResultData) => EntityField RepMeasure typ
RepMeasureRepResult forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Key RepResultData
x)
                [Key RepResultData]
_   -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Key RepResultData) => EntityField RepMeasure typ
RepMeasureRepResult forall typ.
PersistField typ =>
SqlExpr (Value typ)
-> SqlExpr (ValueList typ) -> SqlExpr (Value Bool)
`E.in_` forall typ. PersistField typ => [typ] -> SqlExpr (ValueList typ)
E.valList [Key RepResultData]
xs)
              SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepResultStep)
result forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Text) => EntityField RepResultStep typ
RepResultStepName forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Text
measureName)
              [SqlExpr OrderBy] -> SqlQuery ()
E.orderBy [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
E.asc (SqlExpr (Entity RepMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepetNr) => EntityField RepMeasure typ
RepMeasurePeriod)]
              forall a. ToSomeValues a => a -> SqlQuery ()
E.groupBy (SqlExpr (Entity RepMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepetNr) => EntityField RepMeasure typ
RepMeasurePeriod)
              forall (m :: * -> *) a. Monad m => a -> m a
return (SqlExpr (Entity RepMeasure)
measure forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepetNr) => EntityField RepMeasure typ
RepMeasurePeriod, forall a b.
(PersistField a, PersistField b) =>
SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
E.avg_ forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity RepResultStep)
result forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Double) => EntityField RepResultStep typ
RepResultStepYValue)
      keys :: [Keys]
keys = forall a b. (a -> b) -> [a] -> [b]
map (ResultDataKey -> Keys
toKeys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. Lens' (ResultData a) ResultDataKey
resultDataKey) [ResultData a]
resData
      toKeys :: ResultDataKey -> Keys
toKeys (ResultDataRep Key RepResultData
key)    = [Key RepResultData] -> Keys
ResultDataRepKeys [Key RepResultData
key]
      toKeys (ResultDataWarmUp Key WarmUpResultData
key) = [Key WarmUpResultData] -> Keys
ResultDataWarmUpKeys [Key WarmUpResultData
key]
      toKeys (ResultDataPrep Key PrepResultData
key)   = [Key PrepResultData] -> Keys
ResultDataPrepKeys [Key PrepResultData
key]


  -- let toMeasure (E.Value p, E.Value v) = Measure p [StepResult measureName Nothing v]
  forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
C.runConduit forall a b. (a -> b) -> a -> b
$
    ConduitT
  ()
  (Value RepetNr, Value (Maybe Double))
  (ReaderT SqlBackend (LoggingT (ResourceT IO)))
  ()
vals forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.mapC (Value RepetNr, Value (Maybe Double)) -> (RepetNr, Double)
fromValueC forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *).
Monad m =>
Smoothing -> ConduitT (RepetNr, Double) (RepetNr, Double) m ()
smoothC Smoothing
smoothing forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.mapC forall {a} {a}. (Show a, Show a) => (a, a) -> String
toFileCts forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
C.filterC (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.mapC (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ String
"\n")) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) text binary.
(Monad m, Utf8 text binary) =>
ConduitT text binary m ()
C.encodeUtf8C forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) o.
MonadIO m =>
Handle -> ConduitT ByteString o m ()
sinkHandle Handle
fileH

  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
fileH forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
fileH
  UTCTime
end <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  $(logInfo) forall a b. (a -> b) -> a -> b
$ Text
"Done. Computation Time: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
end UTCTime
start)
  where
    filePath :: String
filePath = String
folder String -> String -> String
</> Text -> String
T.unpack (Text
prefix forall a. Semigroup a => a -> a -> a
<> Text
"_" forall a. Semigroup a => a -> a -> a
<> Text
measureName forall a. Semigroup a => a -> a -> a
<> Text
".csv")
    filePathPlotSh :: String
filePathPlotSh = String
folder String -> String -> String
</> String
"plot.sh"
    folder :: String
folder = forall a. Experiments a -> String
expsPath Experiments a
exps String -> String -> String
</> String
"csv"
    header :: String
header = String
"Period\t" forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Text
prefix forall a. Semigroup a => a -> a -> a
<> Text
"_" forall a. Semigroup a => a -> a -> a
<> Text
measureName) forall a. Semigroup a => a -> a -> a
<> String
"\n"
    toFileCts :: (a, a) -> String
toFileCts (a
p, a
res) = forall a. Show a => a -> String
show a
p forall a. Semigroup a => a -> a -> a
<> String
"\t" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
res
    fromValueC :: (E.Value Int, E.Value (Maybe Double)) -> (Int, Double)
    fromValueC :: (Value RepetNr, Value (Maybe Double)) -> (RepetNr, Double)
fromValueC (Value RepetNr
vPeriod, Value (Maybe Double)
vMVal) = (forall a. Value a -> a
E.unValue Value RepetNr
vPeriod, forall a. a -> Maybe a -> a
fromMaybe Double
0 forall a b. (a -> b) -> a -> b
$ forall a. Value a -> a
E.unValue Value (Maybe Double)
vMVal)


-- smoothAndWriteFileResultData :: Experiments a -> T.Text -> Smoothing -> MeasureName -> ResultData a -> DB IO ()
-- smoothAndWriteFileResultData exps prefix smoothing measureName resData = do
--   $(logInfo) $ "Processing measure " <> measureName <> ". Saving data to: " <> T.pack folder
--   liftIO $ createDirectoryIfMissing True folder
--   liftIO $ writeFile filePath header >> writeFile filePathPlotSh plotSh
--   fileH <- liftIO $ openFile filePath AppendMode
--   start <- liftIO getCurrentTime
--   let src =
--         E.selectSource $
--         case resData ^. resultDataKey of
--           ResultDataPrep key ->
--             E.from $ \(measure `E.InnerJoin` result) -> do
--               E.on (measure E.^. PrepMeasureId E.==. result E.^. PrepResultStepMeasure)
--               E.where_ (measure E.^. PrepMeasurePrepResultData E.==. E.val key)
--               E.where_ (result E.^. PrepResultStepName E.==. E.val measureName)
--               E.orderBy [E.asc (measure E.^. PrepMeasurePeriod)]
--               return (measure E.^. PrepMeasurePeriod, result E.^. PrepResultStepYValue)
--           ResultDataWarmUp key -> undefined
--           ResultDataRep key -> undefined
--   let toMeasure (E.Value p, E.Value v) = Measure p [StepResult measureName Nothing v]
--   C.runConduit $
--     src C..| C.mapC toMeasure C..| smoothC smoothing C..| C.mapC toFileCts C..| C.filterC (not . null) C..| C.mapC (T.pack . (++ "\n")) C..| C.encodeUtf8C C..| sinkHandle fileH
--   liftIO $ hFlush fileH >> hClose fileH
--   end <- liftIO getCurrentTime
--   $(logInfo) $ "Done. Computation Time: " <> tshow (diffUTCTime end start)
--   where
--     filePath = folder </> T.unpack (prefix <> "_" <> measureName <> ".csv")
--     filePathPlotSh = folder </> "plot.sh"
--     folder = expsPath exps </> "csv"
--     header = "Period\t" <> T.unpack (prefix <> "_" <> measureName) <> "\n"
--     toFileCts (Measure p []) = []
--     toFileCts (Measure p [res]) = show p <> "\t" <> show (res ^. resultYValue)
--     toFileCts (Measure p _) = error $ "The measure " <> T.unpack measureName <> " has more than one results in period " <> show p


namePrefix :: Int -> Phase -> Avg -> T.Text
namePrefix :: RepetNr -> Phase -> Avg -> Text
namePrefix RepetNr
expNr Phase
ph Avg
av = Text
"exp" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow RepetNr
expNr forall a. Semigroup a => a -> a -> a
<> Text
"_" forall a. Semigroup a => a -> a -> a
<> Phase -> Text
phaseName Phase
ph forall a. Semigroup a => a -> a -> a
<> Text
"_" forall a. Semigroup a => a -> a -> a
<> Avg -> Text
avgName Avg
av forall a. Semigroup a => a -> a -> a
<> Text
"_"

phaseName :: Phase -> T.Text
phaseName :: Phase -> Text
phaseName Phase
PreparationPhase = Text
"prep"
phaseName Phase
WarmUpPhase      = Text
"warmUp"
phaseName Phase
EvaluationPhase  = Text
"eval"

type ReplNr = Int
type RepetNr = Int
data Avg = None !RepetNr !(Maybe ReplNr) | Repl !RepetNr | Repet !ReplNr | RepetRepl

avgName :: Avg -> T.Text
avgName :: Avg -> Text
avgName (None RepetNr
repet (Just RepetNr
repl)) = Text
"repet" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow RepetNr
repet forall a. Semigroup a => a -> a -> a
<> Text
"_repl" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow RepetNr
repl
avgName (None RepetNr
repet Maybe RepetNr
Nothing)     = Text
"repet" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow RepetNr
repet
avgName (Repl RepetNr
repet)             = Text
"repet" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow RepetNr
repet forall a. Semigroup a => a -> a -> a
<> Text
"_replAvg"
avgName (Repet RepetNr
repl)             = Text
"repetAvg_repl" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow RepetNr
repl
avgName Avg
RepetRepl                = Text
"repetAvg_replAvg"

plotSh :: String
plotSh :: String
plotSh =
  [String] -> String
unlines
    [ String
"FILES=\"\"                                               "
    , String
"                                                         "
    , String
"for arg in $@; do                                        "
    , String
"     FILES=\"$FILES `find . -type f -name \"*$arg*\"`\"  "
    , String
"done                                                     "
    , String
"                                                         "
    , String
"echo $FILES                                              "
    , String
"                                                         "
    , String
"ARRAY=($FILES)                                           "
    , String
"for col in {2,3,4}; do                                   "
    , String
"    CMD=\"set key autotitle columnhead; plot \"          "
    , String
"    for f in $FILES; do                                  "
    , String
"        echo $f                                          "
    , String
"        CMD=\"$CMD '$f' using 0:$col with lines \"       "
    , String
"        if [ \"$f\" != \"${ARRAY[-1]}\" ]; then          "
    , String
"            CMD=\"$CMD, \"                               "
    , String
"        fi                                               "
    , String
"    done                                                 "
    , String
"    CMD=\"$CMD; pause mouse close; \"                    "
    , String
"    echo $CMD                                            "
    , String
"    gnuplot -e \"$CMD\" &                                "
    , String
"done                                                     "
    ]