module RSAGL.FRP.Accumulation
(delay,
integral,
derivative,
accumulateNumerical,
integralRK4,
integralRK4',
summation,
threadTime,
sticky,
initial,
EdgeDetectionMode(..),
edge,
changed,
clingy)
where
import RSAGL.FRP.FRP
import RSAGL.FRP.Time
import RSAGL.FRP.RK4
import Control.Arrow
import RSAGL.Math.AbstractVector
import Data.Maybe
delay :: x -> FRP e m x x
delay initial_value = accumulate (initial_value,error "delay: impossible") (\new_value (old_value,_) -> (new_value,old_value)) >>> arr snd
integral :: (AbstractVector v,AbstractAdd p v) => p -> FRP e m (Rate v) p
integral initial_value = proc v ->
do delta_t <- deltaTime -< ()
(new_accum,_) <- accumulate (zero,perSecond zero) (\(delta_t,new_rate) (old_accum,old_rate) ->
(old_accum `add` ((scalarMultiply (recip 2) $ new_rate `add` old_rate) `over` delta_t),new_rate)) -< (delta_t,v)
returnA -< initial_value `add` new_accum
derivative :: (AbstractVector v,AbstractSubtract p v) => FRP e m p (Rate v)
derivative = proc new_value ->
do delta_t <- deltaTime -< ()
m_old_value <- delay Nothing -< Just new_value
let z = perSecond zero
returnA -< maybe z (\old_value -> if delta_t == zero then z else (new_value `sub` old_value) `per` delta_t) m_old_value
accumulateNumerical :: Frequency -> (i -> o -> Time -> Time -> Integer -> o) -> o -> FRP e m i o
accumulateNumerical frequency accumF initial_value = proc i ->
do absolute_time <- absoluteTime -< ()
delta_t <- deltaTime -< ()
accumulate initial_value (\(i,absolute_time',delta_t',frames) o -> accumF i o absolute_time' delta_t' frames) -<
(i,absolute_time,delta_t,ceiling $ toSeconds delta_t / toSeconds (interval frequency))
integralRK4 :: (AbstractVector v) => Frequency -> (p -> v -> p) -> p -> FRP e m (Time -> p -> Rate v) p
integralRK4 f addPV = accumulateNumerical f (\diffF p abs_t delta_t -> integrateRK4 addPV diffF p (abs_t `sub` delta_t) abs_t)
integralRK4' :: (AbstractVector v) => Frequency -> (p -> v -> p) -> (p,Rate v) ->
FRP e m (Time -> p -> Rate v -> Acceleration v) (p,Rate v)
integralRK4' f addPV = accumulateNumerical f (\diffF p abs_t delta_t -> integrateRK4' addPV diffF p (abs_t `sub` delta_t) abs_t)
summation :: (AbstractAdd p v) => p -> FRP e m v p
summation initial_value = accumulate initial_value (\v p -> p `add` v)
threadTime :: FRP e m () Time
threadTime = summation zero <<< deltaTime
data EdgeDetectionMode = Fuzzy | Discrete
sticky :: (x -> Bool) -> x -> FRP e m x x
sticky f x = accumulate x (\new_x old_x -> if f new_x then new_x else old_x)
initial :: FRP e m x x
initial = accumulate Nothing (\new_x m_old_x -> Just $ fromMaybe new_x m_old_x) >>> arr (fromMaybe $ error "initial: impossible happened")
edge :: EdgeDetectionMode -> (x -> x -> Bool) -> FRP e m x Bool
edge Discrete predicateF = proc x ->
do d_x <- delay Nothing -< Just x
returnA -< maybe True (not . predicateF x) d_x
edge Fuzzy predicateF = arr snd <<< accumulate (Nothing,error "changed: impossible")
(\x_now (x_old,_) -> if maybe True (predicateF x_now) x_old
then (x_old,False)
else (Just x_now,True))
changed :: (x -> x -> Bool) -> FRP e m x Bool
changed = edge Discrete
clingy :: EdgeDetectionMode -> (j -> j -> Bool) -> (j -> p) -> FRP e m j p
clingy edm predicateF f = proc j ->
do e <- edge edm predicateF -< j
arr snd <<< sticky fst (error "clingy: impossible") -< (e,f j)