module Simulation.Aivika.Results
(
Results,
ResultTransform,
ResultName,
ResultProvider(..),
results,
expandResults,
resultSummary,
resultByName,
resultByProperty,
resultByIndex,
resultBySubscript,
ResultComputing(..),
ResultComputation(..),
ResultListWithSubscript(..),
ResultArrayWithSubscript(..),
#ifndef __HASTE__
ResultVectorWithSubscript(..),
#endif
ResultExtract(..),
extractIntResults,
extractIntListResults,
extractIntStatsResults,
extractIntStatsEitherResults,
extractIntTimingStatsResults,
extractDoubleResults,
extractDoubleListResults,
extractDoubleStatsResults,
extractDoubleStatsEitherResults,
extractDoubleTimingStatsResults,
extractStringResults,
ResultPredefinedSignals(..),
newResultPredefinedSignals,
resultSignal,
pureResultSignal,
ResultSourceMap,
ResultSource(..),
ResultItem(..),
ResultItemable(..),
resultItemToIntStatsEitherValue,
resultItemToDoubleStatsEitherValue,
ResultObject(..),
ResultProperty(..),
ResultVector(..),
memoResultVectorSignal,
memoResultVectorSummary,
ResultSeparator(..),
ResultValue(..),
voidResultValue,
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,
resultsToIntValues,
resultsToIntListValues,
resultsToIntStatsValues,
resultsToIntStatsEitherValues,
resultsToIntTimingStatsValues,
resultsToDoubleValues,
resultsToDoubleListValues,
resultsToDoubleStatsValues,
resultsToDoubleStatsEitherValues,
resultsToDoubleTimingStatsValues,
resultsToStringValues,
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.Light 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.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
resultItemToIntValue :: a -> ResultValue Int
resultItemToIntListValue :: a -> ResultValue [Int]
resultItemToIntStatsValue :: a -> ResultValue (SamplingStats Int)
resultItemToIntTimingStatsValue :: a -> ResultValue (TimingStats Int)
resultItemToDoubleValue :: a -> ResultValue Double
resultItemToDoubleListValue :: a -> ResultValue [Double]
resultItemToDoubleStatsValue :: a -> ResultValue (SamplingStats Double)
resultItemToDoubleTimingStatsValue :: a -> ResultValue (TimingStats Double)
resultItemToStringValue :: a -> ResultValue String
resultItemToIntStatsEitherValue :: ResultItemable a => a -> ResultValue (Either Int (SamplingStats Int))
resultItemToIntStatsEitherValue x =
case resultValueData x1 of
Just a1 -> fmap Left x1
Nothing ->
case resultValueData x2 of
Just a2 -> fmap Right x2
Nothing -> voidResultValue x2
where
x1 = resultItemToIntValue x
x2 = resultItemToIntStatsValue x
resultItemToDoubleStatsEitherValue :: ResultItemable a => a -> ResultValue (Either Double (SamplingStats Double))
resultItemToDoubleStatsEitherValue x =
case resultValueData x1 of
Just a1 -> fmap Left x1
Nothing ->
case resultValueData x2 of
Just a2 -> fmap Right x2
Nothing -> voidResultValue x2
where
x1 = resultItemToDoubleValue x
x2 = resultItemToDoubleStatsValue x
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 (fmap f) (resultValueData x) }
voidResultValue :: ResultValue a -> ResultValue b
voidResultValue x = x { resultValueData = Nothing }
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 (Just . 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 (Just . 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 (Just . 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 $ 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 = Maybe (Event e)
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
resultItemToIntValue = id
resultItemToIntListValue = fmap return
resultItemToIntStatsValue = fmap returnSamplingStats
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = fmap fromIntegral
resultItemToDoubleListValue = fmap (return . fromIntegral)
resultItemToDoubleStatsValue = fmap (returnSamplingStats . fromIntegral)
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue Double) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = id
resultItemToDoubleListValue = fmap return
resultItemToDoubleStatsValue = fmap returnSamplingStats
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue [Int]) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = id
resultItemToIntStatsValue = fmap listSamplingStats
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = fmap (map fromIntegral)
resultItemToDoubleStatsValue = fmap (fromIntSamplingStats . listSamplingStats)
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue [Double]) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = id
resultItemToDoubleStatsValue = fmap listSamplingStats
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue (SamplingStats Int)) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = id
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = fmap fromIntSamplingStats
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = fmap show
resultItemExpansion = samplingStatsResultSource
resultItemSummary = samplingStatsResultSummary
instance ResultItemable (ResultValue (SamplingStats Double)) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = id
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = fmap show
resultItemExpansion = samplingStatsResultSource
resultItemSummary = samplingStatsResultSummary
instance ResultItemable (ResultValue (TimingStats Int)) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = id
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = fmap fromIntTimingStats
resultItemToStringValue = fmap show
resultItemExpansion = timingStatsResultSource
resultItemSummary = timingStatsResultSummary
instance ResultItemable (ResultValue (TimingStats Double)) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = id
resultItemToStringValue = fmap show
resultItemExpansion = timingStatsResultSource
resultItemSummary = timingStatsResultSummary
instance ResultItemable (ResultValue Bool) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue String) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue ()) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue FCFS) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue LCFS) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue SIRO) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue StaticPriorities) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = 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"
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
data ResultExtract e =
ResultExtract { resultExtractName :: ResultName,
resultExtractId :: ResultId,
resultExtractData :: Event e,
resultExtractSignal :: ResultSignal
}
extractIntResults :: Results -> [ResultExtract Int]
extractIntResults rs = flip map (resultsToIntValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of integer values: extractIntResults"
Just a ->
ResultExtract n i a s
extractIntListResults :: Results -> [ResultExtract [Int]]
extractIntListResults rs = flip map (resultsToIntListValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of lists of integer values: extractIntListResults"
Just a ->
ResultExtract n i a s
extractIntStatsResults :: Results -> [ResultExtract (SamplingStats Int)]
extractIntStatsResults rs = flip map (resultsToIntStatsValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of statistics based on integer values: extractIntStatsResults"
Just a ->
ResultExtract n i a s
extractIntStatsEitherResults :: Results -> [ResultExtract (Either Int (SamplingStats Int))]
extractIntStatsEitherResults rs = flip map (resultsToIntStatsEitherValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of statistics based on integer values: extractIntStatsEitherResults"
Just a ->
ResultExtract n i a s
extractIntTimingStatsResults :: Results -> [ResultExtract (TimingStats Int)]
extractIntTimingStatsResults rs = flip map (resultsToIntTimingStatsValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of timing statistics based on integer values: extractIntTimingStatsResults"
Just a ->
ResultExtract n i a s
extractDoubleResults :: Results -> [ResultExtract Double]
extractDoubleResults rs = flip map (resultsToDoubleValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of double floating point values: extractDoubleResults"
Just a ->
ResultExtract n i a s
extractDoubleListResults :: Results -> [ResultExtract [Double]]
extractDoubleListResults rs = flip map (resultsToDoubleListValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of lists of double floating point values: extractDoubleListResults"
Just a ->
ResultExtract n i a s
extractDoubleStatsResults :: Results -> [ResultExtract (SamplingStats Double)]
extractDoubleStatsResults rs = flip map (resultsToDoubleStatsValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of statistics based on double floating point values: extractDoubleStatsResults"
Just a ->
ResultExtract n i a s
extractDoubleStatsEitherResults :: Results -> [ResultExtract (Either Double (SamplingStats Double))]
extractDoubleStatsEitherResults rs = flip map (resultsToDoubleStatsEitherValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of statistics based on double floating point values: extractDoubleStatsEitherResults"
Just a ->
ResultExtract n i a s
extractDoubleTimingStatsResults :: Results -> [ResultExtract (TimingStats Double)]
extractDoubleTimingStatsResults rs = flip map (resultsToDoubleTimingStatsValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of timing statistics based on double floating point values: extractDoubleTimingStatsResults"
Just a ->
ResultExtract n i a s
extractStringResults :: Results -> [ResultExtract String]
extractStringResults rs = flip map (resultsToStringValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of string values: extractStringResults"
Just a ->
ResultExtract n i a 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 = Just . liftParameter
computeResultSignal = const UnknownResultSignal
instance ResultComputing Simulation where
computeResultData = Just . liftSimulation
computeResultSignal = const UnknownResultSignal
instance ResultComputing Dynamics where
computeResultData = Just . liftDynamics
computeResultSignal = const UnknownResultSignal
instance ResultComputing Event where
computeResultData = Just . id
computeResultSignal = const UnknownResultSignal
instance ResultComputing Ref where
computeResultData = Just . readRef
computeResultSignal = ResultSignal . refChanged_
instance ResultComputing LR.Ref where
computeResultData = Just . LR.readRef
computeResultSignal = const UnknownResultSignal
instance ResultComputing Var where
computeResultData = Just . readVar
computeResultSignal = ResultSignal . varChanged_
instance ResultComputing Signalable where
computeResultData = Just . 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
queueResultSource :: (Show si, Show sm, Show so,
ResultItemable (ResultValue si),
ResultItemable (ResultValue sm),
ResultItemable (ResultValue so))
=> ResultContainer (Q.Queue si qi sm qm so qo 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 qi sm qm so qo 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 qm so qo 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 qm so qo 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 "inputWaitTime" ServerInputWaitTimeId serverInputWaitTime serverInputWaitTimeChanged_,
resultContainerProperty c "processingTime" ServerProcessingTimeId serverProcessingTime serverProcessingTimeChanged_,
resultContainerProperty c "outputWaitTime" ServerOutputWaitTimeId serverOutputWaitTime serverOutputWaitTimeChanged_,
resultContainerProperty c "inputWaitFactor" ServerInputWaitFactorId serverInputWaitFactor serverInputWaitFactorChanged_,
resultContainerProperty c "processingFactor" ServerProcessingFactorId serverProcessingFactor serverProcessingFactorChanged_,
resultContainerProperty c "outputWaitFactor" ServerOutputWaitFactorId serverOutputWaitFactor serverOutputWaitFactorChanged_ ] }
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 "inputWaitFactor" ServerInputWaitFactorId serverInputWaitFactor serverInputWaitFactorChanged_,
resultContainerProperty c "processingFactor" ServerProcessingFactorId serverProcessingFactor serverProcessingFactorChanged_,
resultContainerProperty c "outputWaitFactor" ServerOutputWaitFactorId serverOutputWaitFactor serverOutputWaitFactorChanged_ ] }
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 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 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 qi sm qm so qo 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 qm so qo 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)