| Safe Haskell | Safe-Inferred |
|---|---|
| Language | Haskell2010 |
FRP.Rhine.ClSF.Util
Description
Synopsis
- timeInfo :: Monad m => ClSF m cl a (TimeInfo cl)
- timeInfoOf :: Monad m => (TimeInfo cl -> b) -> ClSF m cl a b
- sinceLastS :: Monad m => ClSF m cl a (Diff (Time cl))
- sinceInitS :: Monad m => ClSF m cl a (Diff (Time cl))
- absoluteS :: Monad m => ClSF m cl a (Time cl)
- tagS :: Monad m => ClSF m cl a (Tag cl)
- sinceStart :: (Monad m, TimeDomain time) => BehaviourF m time a (Diff time)
- (>->) :: Category cat => cat a b -> cat b c -> cat a c
- (<-<) :: Category cat => cat b c -> cat a b -> cat a c
- arr_ :: Arrow a => b -> a c b
- clId :: Monad m => ClSF m cl a a
- integralFrom :: (Monad m, VectorSpace v s, s ~ Diff td) => v -> BehaviorF m td v v
- integral :: (Monad m, VectorSpace v s, s ~ Diff td) => BehaviorF m td v v
- derivativeFrom :: (Monad m, VectorSpace v s, s ~ Diff td) => v -> BehaviorF m td v v
- derivative :: (Monad m, VectorSpace v s, s ~ Diff td) => BehaviorF m td v v
- threePointDerivativeFrom :: (Monad m, VectorSpace v s, s ~ Diff td, Num s) => v -> BehaviorF m td v v
- threePointDerivative :: (Monad m, VectorSpace v s, s ~ Diff td, Num s) => BehaviorF m td v v
- weightedAverageFrom :: (Monad m, VectorSpace v s, s ~ Diff td, Num s) => v -> BehaviorF m td (v, s) v
- averageFrom :: (Monad m, VectorSpace v s, Floating s, s ~ Diff td) => v -> Diff td -> BehaviorF m td v v
- average :: (Monad m, VectorSpace v s, Floating s, s ~ Diff td) => Diff td -> BehaviourF m td v v
- averageLinFrom :: (Monad m, VectorSpace v s, Floating s, s ~ Diff td) => v -> Diff td -> BehaviourF m td v v
- averageLin :: (Monad m, VectorSpace v s, Floating s, s ~ Diff td) => Diff td -> BehaviourF m td v v
- lowPass :: (Monad m, VectorSpace v s, Floating s, s ~ Diff td) => Diff td -> BehaviourF m td v v
- highPass :: (Monad m, VectorSpace v s, Floating s, Eq s, s ~ Diff td) => Diff td -> BehaviourF m td v v
- bandPass :: (Monad m, VectorSpace v s, Floating s, Eq s, s ~ Diff td) => Diff td -> BehaviourF m td v v
- bandStop :: (Monad m, VectorSpace v s, Floating s, Eq s, s ~ Diff td) => Diff td -> BehaviourF m td v v
- keepFirst :: Monad m => ClSF m cl a a
- historySince :: (Monad m, Ord (Diff (Time cl)), TimeDomain (Time cl)) => Diff (Time cl) -> ClSF m cl a (Seq (TimeInfo cl, a))
- delayBy :: (Monad m, Ord (Diff td), TimeDomain td) => Diff td -> BehaviorF m td a a
- timer :: (Monad m, TimeDomain td, Ord (Diff td)) => Diff td -> BehaviorF (ExceptT () m) td a (Diff td)
- timer_ :: (Monad m, TimeDomain td, Ord (Diff td)) => Diff td -> BehaviorF (ExceptT () m) td a ()
- scaledTimer :: (Monad m, TimeDomain td, Fractional (Diff td), Ord (Diff td)) => Diff td -> BehaviorF (ExceptT () m) td a (Diff td)
Read time information
timeInfo :: Monad m => ClSF m cl a (TimeInfo cl) Source #
Read the environment variable, i.e. the TimeInfo.
timeInfoOf :: Monad m => (TimeInfo cl -> b) -> ClSF m cl a b Source #
Utility to apply functions to the current TimeInfo,
such as record selectors:
printAbsoluteTime :: ClSF IO cl () ()
printAbsoluteTime = timeInfoOf absolute >>> arrMCl print
sinceLastS :: Monad m => ClSF m cl a (Diff (Time cl)) Source #
Continuously return the time difference since the last tick.
sinceInitS :: Monad m => ClSF m cl a (Diff (Time cl)) Source #
Continuously return the time difference since clock initialisation.
sinceStart :: (Monad m, TimeDomain time) => BehaviourF m time a (Diff time) Source #
Calculate the time passed since this ClSF was instantiated,
i.e. since the first tick on which this ClSF was run.
This is _not_ the same as sinceInitS,
which measures the time since clock initialisation.
For example, the following gives a sawtooth signal:
sawtooth = safely $ do
try $ sinceStart >>> proc time -> do
throwOn () -time 1
returnA -< time
safe sawtooth
If you replace sinceStart by sinceInitS,
it will usually hang after one second,
since it doesn't reset after restarting the sawtooth.
Even in the absence of conditional activation of ClSFs,
there is a difference:
For a clock that doesn't tick at its initialisation time,
sinceStart and sinceInitS will have a constant offset of the duration between initialisation time and first tick.
Useful aliases
(>->) :: Category cat => cat a b -> cat b c -> cat a c infixr 6 Source #
Alias for >>> (sequential composition)
with higher operator precedence, designed to work with the other operators, e.g.:
clsf1 >-> clsf2 @@ clA |@| clsf3 >-> clsf4 @@ clB
The type signature specialises e.g. to
(>->) :: Monad m => ClSF m cl a b -> ClSF m cl b c -> ClSF m cl a c
arr_ :: Arrow a => b -> a c b Source #
Output a constant value. Specialises e.g. to this type signature:
arr_ :: Monad m => b -> ClSF m cl a b
Basic signal processing components
Integration and differentiation
integralFrom :: (Monad m, VectorSpace v s, s ~ Diff td) => v -> BehaviorF m td v v Source #
The output of integralFrom v0 is the numerical Euler integral
of the input, with initial offset v0.
integral :: (Monad m, VectorSpace v s, s ~ Diff td) => BehaviorF m td v v Source #
Euler integration, with zero initial offset.
derivativeFrom :: (Monad m, VectorSpace v s, s ~ Diff td) => v -> BehaviorF m td v v Source #
The output of derivativeFrom v0 is the numerical derivative of the input,
with a Newton difference quotient.
The input is initialised with v0.
derivative :: (Monad m, VectorSpace v s, s ~ Diff td) => BehaviorF m td v v Source #
Numerical derivative with input initialised to zero.
threePointDerivativeFrom Source #
Arguments
| :: (Monad m, VectorSpace v s, s ~ Diff td, Num s) | |
| => v | The initial position |
| -> BehaviorF m td v v |
Like derivativeFrom, but uses three samples to compute the derivative.
Consequently, it is delayed by one sample.
threePointDerivative :: (Monad m, VectorSpace v s, s ~ Diff td, Num s) => BehaviorF m td v v Source #
Like threePointDerivativeFrom,
but with the initial position initialised to zeroVector.
Averaging and filters
Arguments
| :: (Monad m, VectorSpace v s, s ~ Diff td, Num s) | |
| => v | The initial position |
| -> BehaviorF m td (v, s) v |
A weighted moving average signal function. The output is the average of the first input, weighted by the second input (which is assumed to be always between 0 and 1). The weight is applied to the average of the last tick, so a weight of 1 simply repeats the past value unchanged, whereas a weight of 0 outputs the current value.
Arguments
| :: (Monad m, VectorSpace v s, Floating s, s ~ Diff td) | |
| => v | The initial position |
| -> Diff td | The time scale on which the signal is averaged |
| -> BehaviorF m td v v |
An exponential moving average, or low pass.
It will average out, or filter,
all features below a given time constant t.
(Equivalently, it filters out frequencies above 1 / (2 * pi * t).)
Arguments
| :: (Monad m, VectorSpace v s, Floating s, s ~ Diff td) | |
| => Diff td | The time scale on which the signal is averaged |
| -> BehaviourF m td v v |
An average, or low pass, initialised to zero.
Arguments
| :: (Monad m, VectorSpace v s, Floating s, s ~ Diff td) | |
| => v | The initial position |
| -> Diff td | The time scale on which the signal is averaged |
| -> BehaviourF m td v v |
A linearised version of averageFrom.
It is more efficient, but only accurate
if the supplied time scale is much bigger
than the average time difference between two ticks.
Arguments
| :: (Monad m, VectorSpace v s, Floating s, s ~ Diff td) | |
| => Diff td | The time scale on which the signal is averaged |
| -> BehaviourF m td v v |
Linearised version of average.
First-order filters
lowPass :: (Monad m, VectorSpace v s, Floating s, s ~ Diff td) => Diff td -> BehaviourF m td v v Source #
Alias for average.
Arguments
| :: (Monad m, VectorSpace v s, Floating s, Eq s, s ~ Diff td) | |
| => Diff td | The time constant |
| -> BehaviourF m td v v |
Filters out frequencies below 1 / (2 * pi * t).
Arguments
| :: (Monad m, VectorSpace v s, Floating s, Eq s, s ~ Diff td) | |
| => Diff td | The time constant |
| -> BehaviourF m td v v |
Filters out frequencies other than 1 / (2 * pi * t).
Arguments
| :: (Monad m, VectorSpace v s, Floating s, Eq s, s ~ Diff td) | |
| => Diff td | The time constant |
| -> BehaviourF m td v v |
Filters out the frequency 1 / (2 * pi * t).
Delays
keepFirst :: Monad m => ClSF m cl a a Source #
Remembers and indefinitely outputs ("holds") the first input value.
Arguments
| :: (Monad m, Ord (Diff (Time cl)), TimeDomain (Time cl)) | |
| => Diff (Time cl) | The size of the time window |
| -> ClSF m cl a (Seq (TimeInfo cl, a)) |
Remembers all input values that arrived within a given time window. New values are appended left.
Arguments
| :: (Monad m, Ord (Diff td), TimeDomain td) | |
| => Diff td | The time span to delay the signal |
| -> BehaviorF m td a a |
Delay a signal by certain time span, initialising with the first input.
Timers
timer :: (Monad m, TimeDomain td, Ord (Diff td)) => Diff td -> BehaviorF (ExceptT () m) td a (Diff td) Source #
Throws an exception after the specified time difference,
outputting the time passed since the timer was instantiated.
timer_ :: (Monad m, TimeDomain td, Ord (Diff td)) => Diff td -> BehaviorF (ExceptT () m) td a () Source #
Like timer_, but doesn't output the remaining time at all.
scaledTimer :: (Monad m, TimeDomain td, Fractional (Diff td), Ord (Diff td)) => Diff td -> BehaviorF (ExceptT () m) td a (Diff td) Source #
Like timer, but divides the remaining time by the total time.