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.Math.RK4
import System.Mem.StableName
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 | HashedDiscrete
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 HashedDiscrete predicateF = proc x ->
do x_stable <- ioAction makeStableName -< x
stable_edge <- edge Discrete (==) -< x_stable
edge Discrete (\(a_stable,a) (b_stable,b) -> if a_stable == b_stable then True else predicateF a b) -< (stable_edge,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)