module Simulation.Aivika.Results
(
Results,
ResultTransform,
ResultName,
ResultProvider(..),
results,
expandResults,
resultSummary,
resultByName,
resultByProperty,
resultById,
resultByIndex,
resultBySubscript,
ResultComputing(..),
ResultComputation(..),
ResultListWithSubscript(..),
ResultArrayWithSubscript(..),
#ifndef __HASTE__
ResultVectorWithSubscript(..),
#endif
ResultValue(..),
resultsToIntValues,
resultsToIntListValues,
resultsToIntStatsValues,
resultsToIntStatsEitherValues,
resultsToIntTimingStatsValues,
resultsToDoubleValues,
resultsToDoubleListValues,
resultsToDoubleStatsValues,
resultsToDoubleStatsEitherValues,
resultsToDoubleTimingStatsValues,
resultsToStringValues,
ResultPredefinedSignals(..),
newResultPredefinedSignals,
resultSignal,
pureResultSignal,
ResultSourceMap,
ResultSource(..),
ResultItem(..),
ResultItemable(..),
resultItemAsIntStatsEitherValue,
resultItemAsDoubleStatsEitherValue,
resultItemToIntValue,
resultItemToIntListValue,
resultItemToIntStatsValue,
resultItemToIntStatsEitherValue,
resultItemToIntTimingStatsValue,
resultItemToDoubleValue,
resultItemToDoubleListValue,
resultItemToDoubleStatsValue,
resultItemToDoubleStatsEitherValue,
resultItemToDoubleTimingStatsValue,
resultItemToStringValue,
ResultObject(..),
ResultProperty(..),
ResultVector(..),
memoResultVectorSignal,
memoResultVectorSummary,
ResultSeparator(..),
ResultContainer(..),
resultContainerPropertySource,
resultContainerConstProperty,
resultContainerIntegProperty,
resultContainerProperty,
resultContainerMapProperty,
resultValueToContainer,
resultContainerToValue,
ResultData,
ResultSignal(..),
maybeResultSignal,
textResultSource,
timeResultSource,
resultSourceToIntValues,
resultSourceToIntListValues,
resultSourceToIntStatsValues,
resultSourceToIntStatsEitherValues,
resultSourceToIntTimingStatsValues,
resultSourceToDoubleValues,
resultSourceToDoubleListValues,
resultSourceToDoubleStatsValues,
resultSourceToDoubleStatsEitherValues,
resultSourceToDoubleTimingStatsValues,
resultSourceToStringValues,
resultSourceMap,
resultSourceList,
composeResults,
computeResultValue) where
import Control.Monad
import Control.Monad.Trans
import qualified Data.Map as M
import qualified Data.Array as A
#ifndef __HASTE__
import qualified Data.Vector as V
#endif
import Data.Ix
import Data.Maybe
import Data.Monoid
import Simulation.Aivika.Parameter
import Simulation.Aivika.Simulation
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Event
import Simulation.Aivika.Signal
import Simulation.Aivika.Statistics
import Simulation.Aivika.Statistics.Accumulator
import Simulation.Aivika.Ref
import qualified Simulation.Aivika.Ref.Plain as LR
import Simulation.Aivika.Var
import Simulation.Aivika.QueueStrategy
import qualified Simulation.Aivika.Queue as Q
import qualified Simulation.Aivika.Queue.Infinite as IQ
import Simulation.Aivika.Arrival
import Simulation.Aivika.Server
import Simulation.Aivika.Activity
import Simulation.Aivika.Results.Locale
type ResultName = String
class ResultProvider p where
resultSource :: ResultName -> ResultDescription -> p -> ResultSource
resultSource name descr = resultSource' name (UserDefinedResultId descr)
resultSource' :: ResultName -> ResultId -> p -> ResultSource
type ResultSourceMap = M.Map ResultName ResultSource
data ResultSource = ResultItemSource ResultItem
| ResultObjectSource ResultObject
| ResultVectorSource ResultVector
| ResultSeparatorSource ResultSeparator
data ResultItem = forall a. ResultItemable a => ResultItem a
class ResultItemable a where
resultItemName :: a -> ResultName
resultItemId :: a -> ResultId
resultItemSignal :: a -> ResultSignal
resultItemExpansion :: a -> ResultSource
resultItemSummary :: a -> ResultSource
resultItemAsIntValue :: a -> Maybe (ResultValue Int)
resultItemAsIntListValue :: a -> Maybe (ResultValue [Int])
resultItemAsIntStatsValue :: a -> Maybe (ResultValue (SamplingStats Int))
resultItemAsIntTimingStatsValue :: a -> Maybe (ResultValue (TimingStats Int))
resultItemAsDoubleValue :: a -> Maybe (ResultValue Double)
resultItemAsDoubleListValue :: a -> Maybe (ResultValue [Double])
resultItemAsDoubleStatsValue :: a -> Maybe (ResultValue (SamplingStats Double))
resultItemAsDoubleTimingStatsValue :: a -> Maybe (ResultValue (TimingStats Double))
resultItemAsStringValue :: a -> Maybe (ResultValue String)
resultItemAsIntStatsEitherValue :: ResultItemable a => a -> Maybe (ResultValue (Either Int (SamplingStats Int)))
resultItemAsIntStatsEitherValue x =
case x1 of
Just a1 -> Just $ fmap Left a1
Nothing ->
case x2 of
Just a2 -> Just $ fmap Right a2
Nothing -> Nothing
where
x1 = resultItemAsIntValue x
x2 = resultItemAsIntStatsValue x
resultItemAsDoubleStatsEitherValue :: ResultItemable a => a -> Maybe (ResultValue (Either Double (SamplingStats Double)))
resultItemAsDoubleStatsEitherValue x =
case x1 of
Just a1 -> Just $ fmap Left a1
Nothing ->
case x2 of
Just a2 -> Just $ fmap Right a2
Nothing -> Nothing
where
x1 = resultItemAsDoubleValue x
x2 = resultItemAsDoubleStatsValue x
resultItemToIntValue :: ResultItemable a => a -> ResultValue Int
resultItemToIntValue x =
case resultItemAsIntValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of integer numbers: resultItemToIntValue"
resultItemToIntListValue :: ResultItemable a => a -> ResultValue [Int]
resultItemToIntListValue x =
case resultItemAsIntListValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of lists of integer numbers: resultItemToIntListValue"
resultItemToIntStatsValue :: ResultItemable a => a -> ResultValue (SamplingStats Int)
resultItemToIntStatsValue x =
case resultItemAsIntStatsValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of statistics based on integer numbers: resultItemToIntStatsValue"
resultItemToIntStatsEitherValue :: ResultItemable a => a -> ResultValue (Either Int (SamplingStats Int))
resultItemToIntStatsEitherValue x =
case resultItemAsIntStatsEitherValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as an optimised source of statistics based on integer numbers: resultItemToIntStatsEitherValue"
resultItemToIntTimingStatsValue :: ResultItemable a => a -> ResultValue (TimingStats Int)
resultItemToIntTimingStatsValue x =
case resultItemAsIntTimingStatsValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of timing statistics based on integer numbers: resultItemToIntTimingStatsValue"
resultItemToDoubleValue :: ResultItemable a => a -> ResultValue Double
resultItemToDoubleValue x =
case resultItemAsDoubleValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of double-precision floating-point numbers: resultItemToDoubleValue"
resultItemToDoubleListValue :: ResultItemable a => a -> ResultValue [Double]
resultItemToDoubleListValue x =
case resultItemAsDoubleListValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of lists of double-precision floating-point numbers: resultItemToDoubleListValue"
resultItemToDoubleStatsValue :: ResultItemable a => a -> ResultValue (SamplingStats Double)
resultItemToDoubleStatsValue x =
case resultItemAsDoubleStatsValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of statistics based on double-precision floating-point numbers: resultItemToDoubleStatsValue"
resultItemToDoubleStatsEitherValue :: ResultItemable a => a -> ResultValue (Either Double (SamplingStats Double))
resultItemToDoubleStatsEitherValue x =
case resultItemAsDoubleStatsEitherValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as an optimised source of statistics based on double-precision floating-point numbers: resultItemToDoubleStatsEitherValue"
resultItemToDoubleTimingStatsValue :: ResultItemable a => a -> ResultValue (TimingStats Double)
resultItemToDoubleTimingStatsValue x =
case resultItemAsDoubleTimingStatsValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of timing statistics based on double-precision floating-point numbers: resultItemToDoubleTimingStatsValue"
resultItemToStringValue :: ResultItemable a => a -> ResultValue String
resultItemToStringValue x =
case resultItemAsStringValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of strings: resultItemToStringValue"
data ResultObject =
ResultObject { resultObjectName :: ResultName,
resultObjectId :: ResultId,
resultObjectTypeId :: ResultId,
resultObjectProperties :: [ResultProperty],
resultObjectSignal :: ResultSignal,
resultObjectSummary :: ResultSource
}
data ResultProperty =
ResultProperty { resultPropertyLabel :: ResultName,
resultPropertyId :: ResultId,
resultPropertySource :: ResultSource
}
data ResultVector =
ResultVector { resultVectorName :: ResultName,
resultVectorId :: ResultId,
resultVectorItems :: A.Array Int ResultSource,
resultVectorSubscript :: A.Array Int ResultName,
resultVectorSignal :: ResultSignal,
resultVectorSummary :: ResultSource
}
memoResultVectorSignal :: ResultVector -> ResultVector
memoResultVectorSignal x =
x { resultVectorSignal =
foldr (<>) mempty $ map resultSourceSignal $ A.elems $ resultVectorItems x }
memoResultVectorSummary :: ResultVector -> ResultVector
memoResultVectorSummary x =
x { resultVectorSummary =
ResultVectorSource $
x { resultVectorItems =
A.array bnds [(i, resultSourceSummary e) | (i, e) <- ies] } }
where
arr = resultVectorItems x
bnds = A.bounds arr
ies = A.assocs arr
data ResultSeparator =
ResultSeparator { resultSeparatorText :: String
}
data ResultValue e =
ResultValue { resultValueName :: ResultName,
resultValueId :: ResultId,
resultValueData :: ResultData e,
resultValueSignal :: ResultSignal
}
instance Functor ResultValue where
fmap f x = x { resultValueData = fmap f (resultValueData x) }
apResultValue :: ResultData (a -> b) -> ResultValue a -> ResultValue b
apResultValue f x = x { resultValueData = ap f (resultValueData x) }
data ResultContainer e =
ResultContainer { resultContainerName :: ResultName,
resultContainerId :: ResultId,
resultContainerData :: e,
resultContainerSignal :: ResultSignal
}
instance Functor ResultContainer where
fmap f x = x { resultContainerData = f (resultContainerData x) }
resultContainerPropertySource :: ResultItemable (ResultValue b)
=> ResultContainer a
-> ResultName
-> ResultId
-> (a -> ResultData b)
-> (a -> ResultSignal)
-> ResultSource
resultContainerPropertySource cont name i f g =
ResultItemSource $
ResultItem $
ResultValue {
resultValueName = (resultContainerName cont) ++ "." ++ name,
resultValueId = i,
resultValueData = f (resultContainerData cont),
resultValueSignal = g (resultContainerData cont) }
resultContainerConstProperty :: ResultItemable (ResultValue b)
=> ResultContainer a
-> ResultName
-> ResultId
-> (a -> b)
-> ResultProperty
resultContainerConstProperty cont name i f =
ResultProperty {
resultPropertyLabel = name,
resultPropertyId = i,
resultPropertySource =
resultContainerPropertySource cont name i (return . f) (const EmptyResultSignal) }
resultContainerIntegProperty :: ResultItemable (ResultValue b)
=> ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> ResultProperty
resultContainerIntegProperty cont name i f =
ResultProperty {
resultPropertyLabel = name,
resultPropertyId = i,
resultPropertySource =
resultContainerPropertySource cont name i f (const UnknownResultSignal) }
resultContainerProperty :: ResultItemable (ResultValue b)
=> ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty cont name i f g =
ResultProperty {
resultPropertyLabel = name,
resultPropertyId = i,
resultPropertySource =
resultContainerPropertySource cont name i f (ResultSignal . g) }
resultContainerMapProperty :: ResultItemable (ResultValue b)
=> ResultContainer (ResultData a)
-> ResultName
-> ResultId
-> (a -> b)
-> ResultProperty
resultContainerMapProperty cont name i f =
ResultProperty {
resultPropertyLabel = name,
resultPropertyId = i,
resultPropertySource =
resultContainerPropertySource cont name i (fmap f) (const $ resultContainerSignal cont) }
resultValueToContainer :: ResultValue a -> ResultContainer (ResultData a)
resultValueToContainer x =
ResultContainer {
resultContainerName = resultValueName x,
resultContainerId = resultValueId x,
resultContainerData = resultValueData x,
resultContainerSignal = resultValueSignal x }
resultContainerToValue :: ResultContainer (ResultData a) -> ResultValue a
resultContainerToValue x =
ResultValue {
resultValueName = resultContainerName x,
resultValueId = resultContainerId x,
resultValueData = resultContainerData x,
resultValueSignal = resultContainerSignal x }
type ResultData e = Event e
normTimingStatsData :: TimingData a => ResultData (TimingStats a -> SamplingStats a)
normTimingStatsData =
do n <- liftDynamics integIteration
return $ normTimingStats (fromIntegral n)
data ResultSignal = EmptyResultSignal
| UnknownResultSignal
| ResultSignal (Signal ())
| ResultSignalMix (Signal ())
instance Monoid ResultSignal where
mempty = EmptyResultSignal
mappend EmptyResultSignal z = z
mappend UnknownResultSignal EmptyResultSignal = UnknownResultSignal
mappend UnknownResultSignal UnknownResultSignal = UnknownResultSignal
mappend UnknownResultSignal (ResultSignal x) = ResultSignalMix x
mappend UnknownResultSignal z@(ResultSignalMix x) = z
mappend z@(ResultSignal x) EmptyResultSignal = z
mappend (ResultSignal x) UnknownResultSignal = ResultSignalMix x
mappend (ResultSignal x) (ResultSignal y) = ResultSignal (x <> y)
mappend (ResultSignal x) (ResultSignalMix y) = ResultSignalMix (x <> y)
mappend z@(ResultSignalMix x) EmptyResultSignal = z
mappend z@(ResultSignalMix x) UnknownResultSignal = z
mappend (ResultSignalMix x) (ResultSignal y) = ResultSignalMix (x <> y)
mappend (ResultSignalMix x) (ResultSignalMix y) = ResultSignalMix (x <> y)
maybeResultSignal :: Maybe (Signal ()) -> ResultSignal
maybeResultSignal (Just x) = ResultSignal x
maybeResultSignal Nothing = EmptyResultSignal
instance ResultItemable (ResultValue Int) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = Just
resultItemAsIntListValue = Just . fmap return
resultItemAsIntStatsValue = Just . fmap returnSamplingStats
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = Just . fmap fromIntegral
resultItemAsDoubleListValue = Just . fmap (return . fromIntegral)
resultItemAsDoubleStatsValue = Just . fmap (returnSamplingStats . fromIntegral)
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue Double) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = Just
resultItemAsDoubleListValue = Just . fmap return
resultItemAsDoubleStatsValue = Just . fmap returnSamplingStats
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue [Int]) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = Just
resultItemAsIntStatsValue = Just . fmap listSamplingStats
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = Just . fmap (map fromIntegral)
resultItemAsDoubleStatsValue = Just . fmap (fromIntSamplingStats . listSamplingStats)
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue [Double]) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = Just
resultItemAsDoubleStatsValue = Just . fmap listSamplingStats
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue (SamplingStats Int)) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = Just
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = Just . fmap fromIntSamplingStats
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = samplingStatsResultSource
resultItemSummary = samplingStatsResultSummary
instance ResultItemable (ResultValue (SamplingStats Double)) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = Just
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = samplingStatsResultSource
resultItemSummary = samplingStatsResultSummary
instance ResultItemable (ResultValue (TimingStats Int)) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = Just . apResultValue normTimingStatsData
resultItemAsIntTimingStatsValue = Just
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = Just . fmap fromIntSamplingStats . apResultValue normTimingStatsData
resultItemAsDoubleTimingStatsValue = Just . fmap fromIntTimingStats
resultItemAsStringValue = Just . fmap show
resultItemExpansion = timingStatsResultSource
resultItemSummary = timingStatsResultSummary
instance ResultItemable (ResultValue (TimingStats Double)) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = Just . apResultValue normTimingStatsData
resultItemAsDoubleTimingStatsValue = Just
resultItemAsStringValue = Just . fmap show
resultItemExpansion = timingStatsResultSource
resultItemSummary = timingStatsResultSummary
instance ResultItemable (ResultValue Bool) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = const Nothing
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue String) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = const Nothing
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue ()) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = const Nothing
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue FCFS) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = const Nothing
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue LCFS) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = const Nothing
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue SIRO) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = const Nothing
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue StaticPriorities) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = const Nothing
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
flattenResultSource :: ResultSource -> [ResultItem]
flattenResultSource (ResultItemSource x) = [x]
flattenResultSource (ResultObjectSource x) =
concat $ map (flattenResultSource . resultPropertySource) $ resultObjectProperties x
flattenResultSource (ResultVectorSource x) =
concat $ map flattenResultSource $ A.elems $ resultVectorItems x
flattenResultSource (ResultSeparatorSource x) = []
resultSourceName :: ResultSource -> ResultName
resultSourceName (ResultItemSource (ResultItem x)) = resultItemName x
resultSourceName (ResultObjectSource x) = resultObjectName x
resultSourceName (ResultVectorSource x) = resultVectorName x
resultSourceName (ResultSeparatorSource x) = []
expandResultSource :: ResultSource -> ResultSource
expandResultSource (ResultItemSource (ResultItem x)) = resultItemExpansion x
expandResultSource (ResultObjectSource x) =
ResultObjectSource $
x { resultObjectProperties =
flip fmap (resultObjectProperties x) $ \p ->
p { resultPropertySource = expandResultSource (resultPropertySource p) } }
expandResultSource (ResultVectorSource x) =
ResultVectorSource $
x { resultVectorItems =
A.array bnds [(i, expandResultSource e) | (i, e) <- ies] }
where arr = resultVectorItems x
bnds = A.bounds arr
ies = A.assocs arr
expandResultSource z@(ResultSeparatorSource x) = z
resultSourceSummary :: ResultSource -> ResultSource
resultSourceSummary (ResultItemSource (ResultItem x)) = resultItemSummary x
resultSourceSummary (ResultObjectSource x) = resultObjectSummary x
resultSourceSummary (ResultVectorSource x) = resultVectorSummary x
resultSourceSummary z@(ResultSeparatorSource x) = z
resultSourceSignal :: ResultSource -> ResultSignal
resultSourceSignal (ResultItemSource (ResultItem x)) = resultItemSignal x
resultSourceSignal (ResultObjectSource x) = resultObjectSignal x
resultSourceSignal (ResultVectorSource x) = resultVectorSignal x
resultSourceSignal (ResultSeparatorSource x) = EmptyResultSignal
resultSourceToIntValues :: ResultSource -> [ResultValue Int]
resultSourceToIntValues = map (\(ResultItem x) -> resultItemToIntValue x) . flattenResultSource
resultSourceToIntListValues :: ResultSource -> [ResultValue [Int]]
resultSourceToIntListValues = map (\(ResultItem x) -> resultItemToIntListValue x) . flattenResultSource
resultSourceToIntStatsValues :: ResultSource -> [ResultValue (SamplingStats Int)]
resultSourceToIntStatsValues = map (\(ResultItem x) -> resultItemToIntStatsValue x) . flattenResultSource
resultSourceToIntStatsEitherValues :: ResultSource -> [ResultValue (Either Int (SamplingStats Int))]
resultSourceToIntStatsEitherValues = map (\(ResultItem x) -> resultItemToIntStatsEitherValue x) . flattenResultSource
resultSourceToIntTimingStatsValues :: ResultSource -> [ResultValue (TimingStats Int)]
resultSourceToIntTimingStatsValues = map (\(ResultItem x) -> resultItemToIntTimingStatsValue x) . flattenResultSource
resultSourceToDoubleValues :: ResultSource -> [ResultValue Double]
resultSourceToDoubleValues = map (\(ResultItem x) -> resultItemToDoubleValue x) . flattenResultSource
resultSourceToDoubleListValues :: ResultSource -> [ResultValue [Double]]
resultSourceToDoubleListValues = map (\(ResultItem x) -> resultItemToDoubleListValue x) . flattenResultSource
resultSourceToDoubleStatsValues :: ResultSource -> [ResultValue (SamplingStats Double)]
resultSourceToDoubleStatsValues = map (\(ResultItem x) -> resultItemToDoubleStatsValue x) . flattenResultSource
resultSourceToDoubleStatsEitherValues :: ResultSource -> [ResultValue (Either Double (SamplingStats Double))]
resultSourceToDoubleStatsEitherValues = map (\(ResultItem x) -> resultItemToDoubleStatsEitherValue x) . flattenResultSource
resultSourceToDoubleTimingStatsValues :: ResultSource -> [ResultValue (TimingStats Double)]
resultSourceToDoubleTimingStatsValues = map (\(ResultItem x) -> resultItemToDoubleTimingStatsValue x) . flattenResultSource
resultSourceToStringValues :: ResultSource -> [ResultValue String]
resultSourceToStringValues = map (\(ResultItem x) -> resultItemToStringValue x) . flattenResultSource
data Results =
Results { resultSourceMap :: ResultSourceMap,
resultSourceList :: [ResultSource]
}
type ResultTransform = Results -> Results
data ResultPredefinedSignals =
ResultPredefinedSignals { resultSignalInIntegTimes :: Signal Double,
resultSignalInStartTime :: Signal Double,
resultSignalInStopTime :: Signal Double
}
newResultPredefinedSignals :: Simulation ResultPredefinedSignals
newResultPredefinedSignals = runDynamicsInStartTime $ runEventWith EarlierEvents d where
d = do signalInIntegTimes <- newSignalInIntegTimes
signalInStartTime <- newSignalInStartTime
signalInStopTime <- newSignalInStopTime
return ResultPredefinedSignals { resultSignalInIntegTimes = signalInIntegTimes,
resultSignalInStartTime = signalInStartTime,
resultSignalInStopTime = signalInStopTime }
instance Monoid Results where
mempty = results mempty
mappend x y = results $ resultSourceList x <> resultSourceList y
results :: [ResultSource] -> Results
results ms =
Results { resultSourceMap = M.fromList $ map (\x -> (resultSourceName x, x)) ms,
resultSourceList = ms }
resultsToIntValues :: Results -> [ResultValue Int]
resultsToIntValues = concat . map resultSourceToIntValues . resultSourceList
resultsToIntListValues :: Results -> [ResultValue [Int]]
resultsToIntListValues = concat . map resultSourceToIntListValues . resultSourceList
resultsToIntStatsValues :: Results -> [ResultValue (SamplingStats Int)]
resultsToIntStatsValues = concat . map resultSourceToIntStatsValues . resultSourceList
resultsToIntStatsEitherValues :: Results -> [ResultValue (Either Int (SamplingStats Int))]
resultsToIntStatsEitherValues = concat . map resultSourceToIntStatsEitherValues . resultSourceList
resultsToIntTimingStatsValues :: Results -> [ResultValue (TimingStats Int)]
resultsToIntTimingStatsValues = concat . map resultSourceToIntTimingStatsValues . resultSourceList
resultsToDoubleValues :: Results -> [ResultValue Double]
resultsToDoubleValues = concat . map resultSourceToDoubleValues . resultSourceList
resultsToDoubleListValues :: Results -> [ResultValue [Double]]
resultsToDoubleListValues = concat . map resultSourceToDoubleListValues . resultSourceList
resultsToDoubleStatsValues :: Results -> [ResultValue (SamplingStats Double)]
resultsToDoubleStatsValues = concat . map resultSourceToDoubleStatsValues . resultSourceList
resultsToDoubleStatsEitherValues :: Results -> [ResultValue (Either Double (SamplingStats Double))]
resultsToDoubleStatsEitherValues = concat . map resultSourceToDoubleStatsEitherValues . resultSourceList
resultsToDoubleTimingStatsValues :: Results -> [ResultValue (TimingStats Double)]
resultsToDoubleTimingStatsValues = concat . map resultSourceToDoubleTimingStatsValues . resultSourceList
resultsToStringValues :: Results -> [ResultValue String]
resultsToStringValues = concat . map resultSourceToStringValues . resultSourceList
resultSignal :: Results -> ResultSignal
resultSignal = mconcat . map resultSourceSignal . resultSourceList
expandResults :: ResultTransform
expandResults = results . map expandResultSource . resultSourceList
resultSummary :: ResultTransform
resultSummary = results . map resultSourceSummary . resultSourceList
resultByName :: ResultName -> ResultTransform
resultByName name rs =
case M.lookup name (resultSourceMap rs) of
Just x -> results [x]
Nothing ->
error $
"Not found result source with name " ++ name ++
": resultByName"
resultByProperty :: ResultName -> ResultTransform
resultByProperty label rs = flip composeResults rs loop
where
loop x =
case x of
ResultObjectSource s ->
let ps =
flip filter (resultObjectProperties s) $ \p ->
resultPropertyLabel p == label
in case ps of
[] ->
error $
"Not found property " ++ label ++
" for object " ++ resultObjectName s ++
": resultByProperty"
ps ->
map resultPropertySource ps
ResultVectorSource s ->
concat $ map loop $ A.elems $ resultVectorItems s
x ->
error $
"Result source " ++ resultSourceName x ++
" is neither object, nor vector " ++
": resultByProperty"
resultById :: ResultId -> ResultTransform
resultById i rs = flip composeResults rs loop
where
loop x =
case x of
ResultItemSource (ResultItem s) ->
if resultItemId s == i
then [x]
else error $
"Expected to find item with Id = " ++ show i ++
", while the item " ++ resultItemName s ++
" has actual Id = " ++ show (resultItemId s) ++
": resultById"
ResultObjectSource s ->
if resultObjectId s == i
then [x]
else let ps =
flip filter (resultObjectProperties s) $ \p ->
resultPropertyId p == i
in case ps of
[] ->
error $
"Not found property with Id = " ++ show i ++
" for object " ++ resultObjectName s ++
" that has actual Id = " ++ show (resultObjectId s) ++
": resultById"
ps ->
map resultPropertySource ps
ResultVectorSource s ->
if resultVectorId s == i
then [x]
else concat $ map loop $ A.elems $ resultVectorItems s
x ->
error $
"Result source " ++ resultSourceName x ++
" is neither item, nor object, nor vector " ++
": resultById"
resultByIndex :: Int -> ResultTransform
resultByIndex index rs = flip composeResults rs loop
where
loop x =
case x of
ResultVectorSource s ->
[resultVectorItems s A.! index]
x ->
error $
"Result source " ++ resultSourceName x ++
" is not vector " ++
": resultByIndex"
resultBySubscript :: ResultName -> ResultTransform
resultBySubscript subscript rs = flip composeResults rs loop
where
loop x =
case x of
ResultVectorSource s ->
let ys = A.elems $ resultVectorItems s
zs = A.elems $ resultVectorSubscript s
ps =
flip filter (zip ys zs) $ \(y, z) ->
z == subscript
in case ps of
[] ->
error $
"Not found subscript " ++ subscript ++
" for vector " ++ resultVectorName s ++
": resultBySubscript"
ps ->
map fst ps
x ->
error $
"Result source " ++ resultSourceName x ++
" is not vector " ++
": resultBySubscript"
composeResults :: (ResultSource -> [ResultSource]) -> ResultTransform
composeResults f =
results . concat . map f . resultSourceList
concatResults :: [ResultTransform] -> ResultTransform
concatResults trs rs =
results $ concat $ map (\tr -> resultSourceList $ tr rs) trs
appendResults :: ResultTransform -> ResultTransform -> ResultTransform
appendResults x y =
concatResults [x, y]
pureResultSignal :: ResultPredefinedSignals -> ResultSignal -> Signal ()
pureResultSignal rs EmptyResultSignal =
void (resultSignalInStartTime rs)
pureResultSignal rs UnknownResultSignal =
void (resultSignalInIntegTimes rs)
pureResultSignal rs (ResultSignal s) =
void (resultSignalInStartTime rs) <> void (resultSignalInStopTime rs) <> s
pureResultSignal rs (ResultSignalMix s) =
void (resultSignalInIntegTimes rs) <> s
class ResultComputing m where
computeResultData :: m a -> ResultData a
computeResultSignal :: m a -> ResultSignal
computeResultValue :: ResultComputing m
=> ResultName
-> ResultId
-> m a
-> ResultValue a
computeResultValue name i m =
ResultValue {
resultValueName = name,
resultValueId = i,
resultValueData = computeResultData m,
resultValueSignal = computeResultSignal m }
data ResultComputation a =
ResultComputation { resultComputationData :: ResultData a,
resultComputationSignal :: ResultSignal
}
instance ResultComputing ResultComputation where
computeResultData = resultComputationData
computeResultSignal = resultComputationSignal
instance ResultComputing Parameter where
computeResultData = liftParameter
computeResultSignal = const UnknownResultSignal
instance ResultComputing Simulation where
computeResultData = liftSimulation
computeResultSignal = const UnknownResultSignal
instance ResultComputing Dynamics where
computeResultData = liftDynamics
computeResultSignal = const UnknownResultSignal
instance ResultComputing Event where
computeResultData = id
computeResultSignal = const UnknownResultSignal
instance ResultComputing Ref where
computeResultData = readRef
computeResultSignal = ResultSignal . refChanged_
instance ResultComputing LR.Ref where
computeResultData = LR.readRef
computeResultSignal = const UnknownResultSignal
instance ResultComputing Var where
computeResultData = readVar
computeResultSignal = ResultSignal . varChanged_
instance ResultComputing Signalable where
computeResultData = readSignalable
computeResultSignal = ResultSignal . signalableChanged_
samplingStatsResultSource :: (ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultValue (SamplingStats a)
-> ResultSource
samplingStatsResultSource x =
ResultObjectSource $
ResultObject {
resultObjectName = resultValueName x,
resultObjectId = resultValueId x,
resultObjectTypeId = SamplingStatsId,
resultObjectSignal = resultValueSignal x,
resultObjectSummary = samplingStatsResultSummary x,
resultObjectProperties = [
resultContainerMapProperty c "count" SamplingStatsCountId samplingStatsCount,
resultContainerMapProperty c "mean" SamplingStatsMeanId samplingStatsMean,
resultContainerMapProperty c "mean2" SamplingStatsMean2Id samplingStatsMean2,
resultContainerMapProperty c "std" SamplingStatsDeviationId samplingStatsDeviation,
resultContainerMapProperty c "var" SamplingStatsVarianceId samplingStatsVariance,
resultContainerMapProperty c "min" SamplingStatsMinId samplingStatsMin,
resultContainerMapProperty c "max" SamplingStatsMaxId samplingStatsMax ] }
where
c = resultValueToContainer x
samplingStatsResultSummary :: ResultItemable (ResultValue (SamplingStats a))
=> ResultValue (SamplingStats a)
-> ResultSource
samplingStatsResultSummary = ResultItemSource . ResultItem . resultItemToStringValue
timingStatsResultSource :: (TimingData a,
ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultValue (TimingStats a)
-> ResultSource
timingStatsResultSource x =
ResultObjectSource $
ResultObject {
resultObjectName = resultValueName x,
resultObjectId = resultValueId x,
resultObjectTypeId = TimingStatsId,
resultObjectSignal = resultValueSignal x,
resultObjectSummary = timingStatsResultSummary x,
resultObjectProperties = [
resultContainerMapProperty c "count" TimingStatsCountId timingStatsCount,
resultContainerMapProperty c "mean" TimingStatsMeanId timingStatsMean,
resultContainerMapProperty c "std" TimingStatsDeviationId timingStatsDeviation,
resultContainerMapProperty c "var" TimingStatsVarianceId timingStatsVariance,
resultContainerMapProperty c "min" TimingStatsMinId timingStatsMin,
resultContainerMapProperty c "max" TimingStatsMaxId timingStatsMax,
resultContainerMapProperty c "minTime" TimingStatsMinTimeId timingStatsMinTime,
resultContainerMapProperty c "maxTime" TimingStatsMaxTimeId timingStatsMaxTime,
resultContainerMapProperty c "startTime" TimingStatsStartTimeId timingStatsStartTime,
resultContainerMapProperty c "lastTime" TimingStatsLastTimeId timingStatsLastTime,
resultContainerMapProperty c "sum" TimingStatsSumId timingStatsSum,
resultContainerMapProperty c "sum2" TimingStatsSum2Id timingStatsSum2 ] }
where
c = resultValueToContainer x
timingStatsResultSummary :: (TimingData a, ResultItemable (ResultValue (TimingStats a)))
=> ResultValue (TimingStats a)
-> ResultSource
timingStatsResultSummary = ResultItemSource . ResultItem . resultItemToStringValue
samplingCounterResultSource :: (ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultValue (SamplingCounter a)
-> ResultSource
samplingCounterResultSource x =
ResultObjectSource $
ResultObject {
resultObjectName = resultValueName x,
resultObjectId = resultValueId x,
resultObjectTypeId = SamplingCounterId,
resultObjectSignal = resultValueSignal x,
resultObjectSummary = samplingCounterResultSummary x,
resultObjectProperties = [
resultContainerMapProperty c "value" SamplingCounterValueId samplingCounterValue,
resultContainerMapProperty c "stats" SamplingCounterStatsId samplingCounterStats ] }
where
c = resultValueToContainer x
samplingCounterResultSummary :: (ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultValue (SamplingCounter a)
-> ResultSource
samplingCounterResultSummary x =
ResultObjectSource $
ResultObject {
resultObjectName = resultValueName x,
resultObjectId = resultValueId x,
resultObjectTypeId = SamplingCounterId,
resultObjectSignal = resultValueSignal x,
resultObjectSummary = samplingCounterResultSummary x,
resultObjectProperties = [
resultContainerMapProperty c "value" SamplingCounterValueId samplingCounterValue,
resultContainerMapProperty c "stats" SamplingCounterStatsId samplingCounterStats ] }
where
c = resultValueToContainer x
timingCounterResultSource :: (ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultValue (TimingCounter a)
-> ResultSource
timingCounterResultSource x =
ResultObjectSource $
ResultObject {
resultObjectName = resultValueName x,
resultObjectId = resultValueId x,
resultObjectTypeId = TimingCounterId,
resultObjectSignal = resultValueSignal x,
resultObjectSummary = timingCounterResultSummary x,
resultObjectProperties = [
resultContainerMapProperty c "value" TimingCounterValueId timingCounterValue,
resultContainerMapProperty c "stats" TimingCounterStatsId timingCounterStats ] }
where
c = resultValueToContainer x
timingCounterResultSummary :: (ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultValue (TimingCounter a)
-> ResultSource
timingCounterResultSummary x =
ResultObjectSource $
ResultObject {
resultObjectName = resultValueName x,
resultObjectId = resultValueId x,
resultObjectTypeId = TimingCounterId,
resultObjectSignal = resultValueSignal x,
resultObjectSummary = timingCounterResultSummary x,
resultObjectProperties = [
resultContainerMapProperty c "value" TimingCounterValueId timingCounterValue,
resultContainerMapProperty c "stats" TimingCounterStatsId timingCounterStats ] }
where
c = resultValueToContainer x
queueResultSource :: (Show si, Show sm, Show so,
ResultItemable (ResultValue si),
ResultItemable (ResultValue sm),
ResultItemable (ResultValue so))
=> ResultContainer (Q.Queue si sm so a)
-> ResultSource
queueResultSource c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = FiniteQueueId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = queueResultSummary c,
resultObjectProperties = [
resultContainerConstProperty c "enqueueStrategy" EnqueueStrategyId Q.enqueueStrategy,
resultContainerConstProperty c "enqueueStoringStrategy" EnqueueStoringStrategyId Q.enqueueStoringStrategy,
resultContainerConstProperty c "dequeueStrategy" DequeueStrategyId Q.dequeueStrategy,
resultContainerProperty c "queueNull" QueueNullId Q.queueNull Q.queueNullChanged_,
resultContainerProperty c "queueFull" QueueFullId Q.queueFull Q.queueFullChanged_,
resultContainerConstProperty c "queueMaxCount" QueueMaxCountId Q.queueMaxCount,
resultContainerProperty c "queueCount" QueueCountId Q.queueCount Q.queueCountChanged_,
resultContainerProperty c "queueCountStats" QueueCountStatsId Q.queueCountStats Q.queueCountChanged_,
resultContainerProperty c "enqueueCount" EnqueueCountId Q.enqueueCount Q.enqueueCountChanged_,
resultContainerProperty c "enqueueLostCount" EnqueueLostCountId Q.enqueueLostCount Q.enqueueLostCountChanged_,
resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId Q.enqueueStoreCount Q.enqueueStoreCountChanged_,
resultContainerProperty c "dequeueCount" DequeueCountId Q.dequeueCount Q.dequeueCountChanged_,
resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId Q.dequeueExtractCount Q.dequeueExtractCountChanged_,
resultContainerProperty c "queueLoadFactor" QueueLoadFactorId Q.queueLoadFactor Q.queueLoadFactorChanged_,
resultContainerIntegProperty c "enqueueRate" EnqueueRateId Q.enqueueRate,
resultContainerIntegProperty c "enqueueStoreRate" EnqueueStoreRateId Q.enqueueStoreRate,
resultContainerIntegProperty c "dequeueRate" DequeueRateId Q.dequeueRate,
resultContainerIntegProperty c "dequeueExtractRate" DequeueExtractRateId Q.dequeueExtractRate,
resultContainerProperty c "queueWaitTime" QueueWaitTimeId Q.queueWaitTime Q.queueWaitTimeChanged_,
resultContainerProperty c "queueTotalWaitTime" QueueTotalWaitTimeId Q.queueTotalWaitTime Q.queueTotalWaitTimeChanged_,
resultContainerProperty c "enqueueWaitTime" EnqueueWaitTimeId Q.enqueueWaitTime Q.enqueueWaitTimeChanged_,
resultContainerProperty c "dequeueWaitTime" DequeueWaitTimeId Q.dequeueWaitTime Q.dequeueWaitTimeChanged_,
resultContainerProperty c "queueRate" QueueRateId Q.queueRate Q.queueRateChanged_ ] }
queueResultSummary :: (Show si, Show sm, Show so)
=> ResultContainer (Q.Queue si sm so a)
-> ResultSource
queueResultSummary c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = FiniteQueueId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = queueResultSummary c,
resultObjectProperties = [
resultContainerConstProperty c "queueMaxCount" QueueMaxCountId Q.queueMaxCount,
resultContainerProperty c "queueCountStats" QueueCountStatsId Q.queueCountStats Q.queueCountChanged_,
resultContainerProperty c "enqueueCount" EnqueueCountId Q.enqueueCount Q.enqueueCountChanged_,
resultContainerProperty c "enqueueLostCount" EnqueueLostCountId Q.enqueueLostCount Q.enqueueLostCountChanged_,
resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId Q.enqueueStoreCount Q.enqueueStoreCountChanged_,
resultContainerProperty c "dequeueCount" DequeueCountId Q.dequeueCount Q.dequeueCountChanged_,
resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId Q.dequeueExtractCount Q.dequeueExtractCountChanged_,
resultContainerProperty c "queueLoadFactor" QueueLoadFactorId Q.queueLoadFactor Q.queueLoadFactorChanged_,
resultContainerProperty c "queueWaitTime" QueueWaitTimeId Q.queueWaitTime Q.queueWaitTimeChanged_,
resultContainerProperty c "queueRate" QueueRateId Q.queueRate Q.queueRateChanged_ ] }
infiniteQueueResultSource :: (Show sm, Show so,
ResultItemable (ResultValue sm),
ResultItemable (ResultValue so))
=> ResultContainer (IQ.Queue sm so a)
-> ResultSource
infiniteQueueResultSource c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = FiniteQueueId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = infiniteQueueResultSummary c,
resultObjectProperties = [
resultContainerConstProperty c "enqueueStoringStrategy" EnqueueStoringStrategyId IQ.enqueueStoringStrategy,
resultContainerConstProperty c "dequeueStrategy" DequeueStrategyId IQ.dequeueStrategy,
resultContainerProperty c "queueNull" QueueNullId IQ.queueNull IQ.queueNullChanged_,
resultContainerProperty c "queueCount" QueueCountId IQ.queueCount IQ.queueCountChanged_,
resultContainerProperty c "queueCountStats" QueueCountStatsId IQ.queueCountStats IQ.queueCountChanged_,
resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId IQ.enqueueStoreCount IQ.enqueueStoreCountChanged_,
resultContainerProperty c "dequeueCount" DequeueCountId IQ.dequeueCount IQ.dequeueCountChanged_,
resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId IQ.dequeueExtractCount IQ.dequeueExtractCountChanged_,
resultContainerIntegProperty c "enqueueStoreRate" EnqueueStoreRateId IQ.enqueueStoreRate,
resultContainerIntegProperty c "dequeueRate" DequeueRateId IQ.dequeueRate,
resultContainerIntegProperty c "dequeueExtractRate" DequeueExtractRateId IQ.dequeueExtractRate,
resultContainerProperty c "queueWaitTime" QueueWaitTimeId IQ.queueWaitTime IQ.queueWaitTimeChanged_,
resultContainerProperty c "dequeueWaitTime" DequeueWaitTimeId IQ.dequeueWaitTime IQ.dequeueWaitTimeChanged_,
resultContainerProperty c "queueRate" QueueRateId IQ.queueRate IQ.queueRateChanged_ ] }
infiniteQueueResultSummary :: (Show sm, Show so)
=> ResultContainer (IQ.Queue sm so a)
-> ResultSource
infiniteQueueResultSummary c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = FiniteQueueId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = infiniteQueueResultSummary c,
resultObjectProperties = [
resultContainerProperty c "queueCountStats" QueueCountStatsId IQ.queueCountStats IQ.queueCountChanged_,
resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId IQ.enqueueStoreCount IQ.enqueueStoreCountChanged_,
resultContainerProperty c "dequeueCount" DequeueCountId IQ.dequeueCount IQ.dequeueCountChanged_,
resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId IQ.dequeueExtractCount IQ.dequeueExtractCountChanged_,
resultContainerProperty c "queueWaitTime" QueueWaitTimeId IQ.queueWaitTime IQ.queueWaitTimeChanged_,
resultContainerProperty c "queueRate" QueueRateId IQ.queueRate IQ.queueRateChanged_ ] }
arrivalTimerResultSource :: ResultContainer ArrivalTimer
-> ResultSource
arrivalTimerResultSource c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ArrivalTimerId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = arrivalTimerResultSummary c,
resultObjectProperties = [
resultContainerProperty c "processingTime" ArrivalProcessingTimeId arrivalProcessingTime arrivalProcessingTimeChanged_ ] }
arrivalTimerResultSummary :: ResultContainer ArrivalTimer
-> ResultSource
arrivalTimerResultSummary c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ArrivalTimerId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = arrivalTimerResultSummary c,
resultObjectProperties = [
resultContainerProperty c "processingTime" ArrivalProcessingTimeId arrivalProcessingTime arrivalProcessingTimeChanged_ ] }
serverResultSource :: (Show s, ResultItemable (ResultValue s))
=> ResultContainer (Server s a b)
-> ResultSource
serverResultSource c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ServerId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = serverResultSummary c,
resultObjectProperties = [
resultContainerConstProperty c "initState" ServerInitStateId serverInitState,
resultContainerProperty c "state" ServerStateId serverState serverStateChanged_,
resultContainerProperty c "totalInputWaitTime" ServerTotalInputWaitTimeId serverTotalInputWaitTime serverTotalInputWaitTimeChanged_,
resultContainerProperty c "totalProcessingTime" ServerTotalProcessingTimeId serverTotalProcessingTime serverTotalProcessingTimeChanged_,
resultContainerProperty c "totalOutputWaitTime" ServerTotalOutputWaitTimeId serverTotalOutputWaitTime serverTotalOutputWaitTimeChanged_,
resultContainerProperty c "totalPreemptionTime" ServerTotalPreemptionTimeId serverTotalPreemptionTime serverTotalPreemptionTimeChanged_,
resultContainerProperty c "inputWaitTime" ServerInputWaitTimeId serverInputWaitTime serverInputWaitTimeChanged_,
resultContainerProperty c "processingTime" ServerProcessingTimeId serverProcessingTime serverProcessingTimeChanged_,
resultContainerProperty c "outputWaitTime" ServerOutputWaitTimeId serverOutputWaitTime serverOutputWaitTimeChanged_,
resultContainerProperty c "preemptionTime" ServerPreemptionTimeId serverPreemptionTime serverPreemptionTimeChanged_,
resultContainerProperty c "inputWaitFactor" ServerInputWaitFactorId serverInputWaitFactor serverInputWaitFactorChanged_,
resultContainerProperty c "processingFactor" ServerProcessingFactorId serverProcessingFactor serverProcessingFactorChanged_,
resultContainerProperty c "outputWaitFactor" ServerOutputWaitFactorId serverOutputWaitFactor serverOutputWaitFactorChanged_,
resultContainerProperty c "preemptionFactor" ServerPreemptionFactorId serverPreemptionFactor serverPreemptionFactorChanged_ ] }
serverResultSummary :: ResultContainer (Server s a b)
-> ResultSource
serverResultSummary c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ServerId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = serverResultSummary c,
resultObjectProperties = [
resultContainerProperty c "inputWaitTime" ServerInputWaitTimeId serverInputWaitTime serverInputWaitTimeChanged_,
resultContainerProperty c "processingTime" ServerProcessingTimeId serverProcessingTime serverProcessingTimeChanged_,
resultContainerProperty c "outputWaitTime" ServerOutputWaitTimeId serverOutputWaitTime serverOutputWaitTimeChanged_,
resultContainerProperty c "preemptionTime" ServerPreemptionTimeId serverPreemptionTime serverPreemptionTimeChanged_,
resultContainerProperty c "inputWaitFactor" ServerInputWaitFactorId serverInputWaitFactor serverInputWaitFactorChanged_,
resultContainerProperty c "processingFactor" ServerProcessingFactorId serverProcessingFactor serverProcessingFactorChanged_,
resultContainerProperty c "outputWaitFactor" ServerOutputWaitFactorId serverOutputWaitFactor serverOutputWaitFactorChanged_,
resultContainerProperty c "preemptionFactor" ServerPreemptionFactorId serverPreemptionFactor serverPreemptionFactorChanged_ ] }
activityResultSource :: (Show s, ResultItemable (ResultValue s))
=> ResultContainer (Activity s a b)
-> ResultSource
activityResultSource c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ActivityId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = activityResultSummary c,
resultObjectProperties = [
resultContainerConstProperty c "initState" ActivityInitStateId activityInitState,
resultContainerProperty c "state" ActivityStateId activityState activityStateChanged_,
resultContainerProperty c "totalUtilisationTime" ActivityTotalUtilisationTimeId activityTotalUtilisationTime activityTotalUtilisationTimeChanged_,
resultContainerProperty c "totalIdleTime" ActivityTotalIdleTimeId activityTotalIdleTime activityTotalIdleTimeChanged_,
resultContainerProperty c "totalPreemptionTime" ActivityTotalPreemptionTimeId activityTotalPreemptionTime activityTotalPreemptionTimeChanged_,
resultContainerProperty c "utilisationTime" ActivityUtilisationTimeId activityUtilisationTime activityUtilisationTimeChanged_,
resultContainerProperty c "idleTime" ActivityIdleTimeId activityIdleTime activityIdleTimeChanged_,
resultContainerProperty c "preemptionTime" ActivityPreemptionTimeId activityPreemptionTime activityPreemptionTimeChanged_,
resultContainerProperty c "utilisationFactor" ActivityUtilisationFactorId activityUtilisationFactor activityUtilisationFactorChanged_,
resultContainerProperty c "idleFactor" ActivityIdleFactorId activityIdleFactor activityIdleFactorChanged_,
resultContainerProperty c "preemptionFactor" ActivityPreemptionFactorId activityPreemptionFactor activityPreemptionFactorChanged_ ] }
activityResultSummary :: ResultContainer (Activity s a b)
-> ResultSource
activityResultSummary c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ActivityId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = activityResultSummary c,
resultObjectProperties = [
resultContainerProperty c "utilisationTime" ActivityUtilisationTimeId activityUtilisationTime activityUtilisationTimeChanged_,
resultContainerProperty c "idleTime" ActivityIdleTimeId activityIdleTime activityIdleTimeChanged_,
resultContainerProperty c "preemptionTime" ActivityPreemptionTimeId activityPreemptionTime activityPreemptionTimeChanged_,
resultContainerProperty c "utilisationFactor" ActivityUtilisationFactorId activityUtilisationFactor activityUtilisationFactorChanged_,
resultContainerProperty c "idleFactor" ActivityIdleFactorId activityIdleFactor activityIdleFactorChanged_,
resultContainerProperty c "preemptionFactor" ActivityPreemptionFactorId activityPreemptionFactor activityPreemptionFactorChanged_ ] }
textResultSource :: String -> ResultSource
textResultSource text =
ResultSeparatorSource $
ResultSeparator { resultSeparatorText = text }
timeResultSource :: ResultSource
timeResultSource = resultSource' "t" TimeId time
intSubscript :: Int -> ResultName
intSubscript i = "[" ++ show i ++ "]"
instance ResultComputing m => ResultProvider (m Double) where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing m => ResultProvider (m [Double]) where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing m => ResultProvider (m (SamplingStats Double)) where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing m => ResultProvider (m (TimingStats Double)) where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing m => ResultProvider (m (SamplingCounter Double)) where
resultSource' name i m =
samplingCounterResultSource $ computeResultValue name i m
instance ResultComputing m => ResultProvider (m (TimingCounter Double)) where
resultSource' name i m =
timingCounterResultSource $ computeResultValue name i m
instance ResultComputing m => ResultProvider (m Int) where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing m => ResultProvider (m [Int]) where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing m => ResultProvider (m (SamplingStats Int)) where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing m => ResultProvider (m (TimingStats Int)) where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing m => ResultProvider (m (SamplingCounter Int)) where
resultSource' name i m =
samplingCounterResultSource $ computeResultValue name i m
instance ResultComputing m => ResultProvider (m (TimingCounter Int)) where
resultSource' name i m =
timingCounterResultSource $ computeResultValue name i m
instance ResultComputing m => ResultProvider (m String) where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultProvider p => ResultProvider [p] where
resultSource' name i m =
resultSource' name i $ ResultListWithSubscript m subscript where
subscript = map snd $ zip m $ map intSubscript [0..]
instance (Show i, Ix i, ResultProvider p) => ResultProvider (A.Array i p) where
resultSource' name i m =
resultSource' name i $ ResultListWithSubscript items subscript where
items = A.elems m
subscript = map (\i -> "[" ++ show i ++ "]") (A.indices m)
#ifndef __HASTE__
instance ResultProvider p => ResultProvider (V.Vector p) where
resultSource' name i m =
resultSource' name i $ ResultVectorWithSubscript m subscript where
subscript = V.imap (\i x -> intSubscript i) m
#endif
data ResultListWithSubscript p =
ResultListWithSubscript [p] [String]
data ResultArrayWithSubscript i p =
ResultArrayWithSubscript (A.Array i p) (A.Array i String)
#ifndef __HASTE__
data ResultVectorWithSubscript p =
ResultVectorWithSubscript (V.Vector p) (V.Vector String)
#endif
instance ResultProvider p => ResultProvider (ResultListWithSubscript p) where
resultSource' name i (ResultListWithSubscript xs ys) =
ResultVectorSource $
memoResultVectorSignal $
memoResultVectorSummary $
ResultVector { resultVectorName = name,
resultVectorId = i,
resultVectorItems = axs,
resultVectorSubscript = ays,
resultVectorSignal = undefined,
resultVectorSummary = undefined }
where
bnds = (0, length xs 1)
axs = A.listArray bnds items
ays = A.listArray bnds ys
items =
flip map (zip ys xs) $ \(y, x) ->
let name' = name ++ y
in resultSource' name' (VectorItemId y) x
items' = map resultSourceSummary items
instance (Show i, Ix i, ResultProvider p) => ResultProvider (ResultArrayWithSubscript i p) where
resultSource' name i (ResultArrayWithSubscript xs ys) =
resultSource' name i $ ResultListWithSubscript items subscript where
items = A.elems xs
subscript = A.elems ys
#ifndef __HASTE__
instance ResultProvider p => ResultProvider (ResultVectorWithSubscript p) where
resultSource' name i (ResultVectorWithSubscript xs ys) =
ResultVectorSource $
memoResultVectorSignal $
memoResultVectorSummary $
ResultVector { resultVectorName = name,
resultVectorId = i,
resultVectorItems = axs,
resultVectorSubscript = ays,
resultVectorSignal = undefined,
resultVectorSummary = undefined }
where
bnds = (0, V.length xs 1)
axs = A.listArray bnds (V.toList items)
ays = A.listArray bnds (V.toList ys)
items =
V.generate (V.length xs) $ \i ->
let x = xs V.! i
y = ys V.! i
name' = name ++ y
in resultSource' name' (VectorItemId y) x
items' = V.map resultSourceSummary items
#endif
instance (Ix i, Show i, ResultComputing m) => ResultProvider (m (A.Array i Double)) where
resultSource' name i m =
ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name i m
instance (Ix i, Show i, ResultComputing m) => ResultProvider (m (A.Array i Int)) where
resultSource' name i m =
ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name i m
#ifndef __HASTE__
instance ResultComputing m => ResultProvider (m (V.Vector Double)) where
resultSource' name i m =
ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name i m
instance ResultComputing m => ResultProvider (m (V.Vector Int)) where
resultSource' name i m =
ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name i m
#endif
instance (Show si, Show sm, Show so,
ResultItemable (ResultValue si),
ResultItemable (ResultValue sm),
ResultItemable (ResultValue so))
=> ResultProvider (Q.Queue si sm so a) where
resultSource' name i m =
queueResultSource $ ResultContainer name i m (ResultSignal $ Q.queueChanged_ m)
instance (Show sm, Show so,
ResultItemable (ResultValue sm),
ResultItemable (ResultValue so))
=> ResultProvider (IQ.Queue sm so a) where
resultSource' name i m =
infiniteQueueResultSource $ ResultContainer name i m (ResultSignal $ IQ.queueChanged_ m)
instance ResultProvider ArrivalTimer where
resultSource' name i m =
arrivalTimerResultSource $ ResultContainer name i m (ResultSignal $ arrivalProcessingTimeChanged_ m)
instance (Show s, ResultItemable (ResultValue s)) => ResultProvider (Server s a b) where
resultSource' name i m =
serverResultSource $ ResultContainer name i m (ResultSignal $ serverChanged_ m)
instance (Show s, ResultItemable (ResultValue s)) => ResultProvider (Activity s a b) where
resultSource' name i m =
activityResultSource $ ResultContainer name i m (ResultSignal $ activityChanged_ m)