event-list-0.0.8: Event lists with relative or absolute time stampsSource codeContentsIndex
Data.EventList.Relative.TimeBody
PortabilityHaskell 98
Stabilitystable
Maintainerhaskell@henning-thielemann.de
Description

Event lists starting with a time difference and ending with a body.

The time is stored in differences between the events. Thus there is no increase of time information for long, or even infinite, streams of events. Further on, the time difference is stored in the latter of two neighbouring events. This is necessary for real-time computing where it is not known whether and when the next event happens.

Synopsis
data T time body
empty :: T time body
singleton :: time -> body -> T time body
null :: T time body -> Bool
viewL :: T time body -> Maybe ((time, body), T time body)
viewR :: T time body -> Maybe (T time body, (time, body))
switchL :: c -> ((time, body) -> T time body -> c) -> T time body -> c
switchR :: c -> (T time body -> (time, body) -> c) -> T time body -> c
cons :: time -> body -> T time body -> T time body
snoc :: T time body -> time -> body -> T time body
fromPairList :: [(a, b)] -> T a b
toPairList :: T a b -> [(a, b)]
getTimes :: T time body -> [time]
getBodies :: T time body -> [body]
duration :: Num time => T time body -> time
mapBody :: (body0 -> body1) -> T time body0 -> T time body1
mapTime :: (time0 -> time1) -> T time0 body -> T time1 body
mapM :: Monad m => (time0 -> m time1) -> (body0 -> m body1) -> T time0 body0 -> m (T time1 body1)
mapM_ :: Monad m => (time -> m ()) -> (body -> m ()) -> T time body -> m ()
mapBodyM :: Monad m => (body0 -> m body1) -> T time body0 -> m (T time body1)
mapTimeM :: Monad m => (time0 -> m time1) -> T time0 body -> m (T time1 body)
foldr :: (time -> a -> b) -> (body -> b -> a) -> b -> T time body -> b
foldrPair :: (time -> body -> a -> a) -> a -> T time body -> a
merge :: (C time, Ord body) => T time body -> T time body -> T time body
mergeBy :: C time => (body -> body -> Bool) -> T time body -> T time body -> T time body
insert :: (C time, Ord body) => time -> body -> T time body -> T time body
insertBy :: (C time, Ord body) => (body -> body -> Bool) -> time -> body -> T time body -> T time body
moveForward :: C time => T time (time, body) -> T time body
decreaseStart :: C time => time -> T time body -> T time body
delay :: C time => time -> T time body -> T time body
filter :: Num time => (body -> Bool) -> T time body -> T time body
partition :: Num time => (body -> Bool) -> T time body -> (T time body, T time body)
slice :: (Eq a, Num time) => (body -> a) -> T time body -> [(a, T time body)]
span :: (body -> Bool) -> T time body -> (T time body, T time body)
mapMaybe :: Num time => (body0 -> Maybe body1) -> T time body0 -> T time body1
catMaybes :: Num time => T time (Maybe body) -> T time body
normalize :: (C time, Ord body) => T time body -> T time body
isNormalized :: (C time, Ord body) => T time body -> Bool
collectCoincident :: C time => T time body -> T time [body]
flatten :: C time => T time [body] -> T time body
mapCoincident :: C time => ([a] -> [b]) -> T time a -> T time b
append :: T time body -> T time body -> T time body
concat :: [T time body] -> T time body
cycle :: T time body -> T time body
discretize :: (C time, RealFrac time, C i, Integral i) => T time body -> T i body
resample :: (C time, RealFrac time, C i, Integral i) => time -> T time body -> T i body
toAbsoluteEventList :: Num time => time -> T time body -> T time body
fromAbsoluteEventList :: Num time => T time body -> T time body
Documentation
data T time body Source
show/hide Instances
(Eq time, Eq body) => Eq (T time body)
(Ord time, Ord body) => Ord (T time body)
(Show time, Show body) => Show (T time body)
(Arbitrary time, Arbitrary body) => Arbitrary (T time body)
empty :: T time bodySource
singleton :: time -> body -> T time bodySource
null :: T time body -> BoolSource
viewL :: T time body -> Maybe ((time, body), T time body)Source
viewR :: T time body -> Maybe (T time body, (time, body))Source
switchL :: c -> ((time, body) -> T time body -> c) -> T time body -> cSource
switchR :: c -> (T time body -> (time, body) -> c) -> T time body -> cSource
cons :: time -> body -> T time body -> T time bodySource
snoc :: T time body -> time -> body -> T time bodySource
fromPairList :: [(a, b)] -> T a bSource
toPairList :: T a b -> [(a, b)]Source
getTimes :: T time body -> [time]Source
getBodies :: T time body -> [body]Source
duration :: Num time => T time body -> timeSource
mapBody :: (body0 -> body1) -> T time body0 -> T time body1Source
mapTime :: (time0 -> time1) -> T time0 body -> T time1 bodySource
mapM :: Monad m => (time0 -> m time1) -> (body0 -> m body1) -> T time0 body0 -> m (T time1 body1)Source
mapM_ :: Monad m => (time -> m ()) -> (body -> m ()) -> T time body -> m ()Source
mapBodyM :: Monad m => (body0 -> m body1) -> T time body0 -> m (T time body1)Source
mapTimeM :: Monad m => (time0 -> m time1) -> T time0 body -> m (T time1 body)Source
foldr :: (time -> a -> b) -> (body -> b -> a) -> b -> T time body -> bSource
foldrPair :: (time -> body -> a -> a) -> a -> T time body -> aSource
merge :: (C time, Ord body) => T time body -> T time body -> T time bodySource
This function merges the events of two lists into a new event list. Note that merge compares entire events rather than just start times. This is to ensure that it is commutative, one of the properties we test for.
mergeBy :: C time => (body -> body -> Bool) -> T time body -> T time body -> T time bodySource
mergeBy is like merge but does not simply use the methods of the Ord class but allows a custom comparison function.
insert :: (C time, Ord body) => time -> body -> T time body -> T time bodySource
insert inserts an event into an event list at the given time.
insertBy :: (C time, Ord body) => (body -> body -> Bool) -> time -> body -> T time body -> T time bodySource
moveForward :: C time => T time (time, body) -> T time bodySource
Move events towards the front of the event list. You must make sure, that no event is moved before time zero. This works only for finite lists.
decreaseStart :: C time => time -> T time body -> T time bodySource
delay :: C time => time -> T time body -> T time bodySource
filter :: Num time => (body -> Bool) -> T time body -> T time bodySource
Keep only events that match a predicate while preserving absolute times.
partition :: Num time => (body -> Bool) -> T time body -> (T time body, T time body)Source
slice :: (Eq a, Num time) => (body -> a) -> T time body -> [(a, T time body)]Source
Using a classification function we splice the event list into lists, each containing the same class. Absolute time stamps are preserved.
span :: (body -> Bool) -> T time body -> (T time body, T time body)Source
mapMaybe :: Num time => (body0 -> Maybe body1) -> T time body0 -> T time body1Source
catMaybes :: Num time => T time (Maybe body) -> T time bodySource
Adds times in a left-associative fashion. Use this if the time is a strict data type.
normalize :: (C time, Ord body) => T time body -> T time bodySource
sort sorts a list of coinciding events, that is all events but the first one have time difference 0. normalize sorts all coinciding events in a list thus yielding a canonical representation of a time ordered list.
isNormalized :: (C time, Ord body) => T time body -> BoolSource
collectCoincident :: C time => T time body -> T time [body]Source
Group events that have equal start times (that is zero time differences).
flatten :: C time => T time [body] -> T time bodySource

Reverse to collectCoincident: Turn each body into a separate event.

   xs  ==  flatten (collectCoincident xs)
mapCoincident :: C time => ([a] -> [b]) -> T time a -> T time bSource
Apply a function to the lists of coincident events.
append :: T time body -> T time body -> T time bodySource
concat :: [T time body] -> T time bodySource
cycle :: T time body -> T time bodySource
discretize :: (C time, RealFrac time, C i, Integral i) => T time body -> T i bodySource

We provide discretize and resample for discretizing the time information. When converting the precise relative event times to the integer relative event times we have to prevent accumulation of rounding errors. We avoid this problem with a stateful conversion which remembers each rounding error we make. This rounding error is used to correct the next rounding. Given the relative time and duration of an event the function floorDiff creates a Control.Monad.State.State which computes the rounded relative time. It is corrected by previous rounding errors.

The resulting event list may have differing time differences which were equal before discretization, but the overall timing is uniformly close to the original.

We use floorDiff rather than roundDiff in order to compute exclusively with non-negative numbers.

resample :: (C time, RealFrac time, C i, Integral i) => time -> T time body -> T i bodySource
toAbsoluteEventList :: Num time => time -> T time body -> T time bodySource
We tried hard to compute everything with respect to relative times. However sometimes we need absolute time values.
fromAbsoluteEventList :: Num time => T time body -> T time bodySource
Produced by Haddock version 2.4.2