Accumulation.hs

{-# LANGUAGE Arrows #-}

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 a piece of data for one frame.
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

-- | Take the integral of a rate over time, using the trapezoidal rule.
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

-- | Take the derivative of a value over time, by simple subtraction between frames.
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

-- | 'accumulate' harness for some numerical methods.
-- Parameters are: current input, previous output, delta time, absolute time, and number of frames at the specified frequency.
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)

-- | Sum some data frame-by-frame.
summation :: (AbstractAdd p v) => p -> FRP e m v p
summation initial_value = accumulate initial_value (\v p -> p `add` v)

-- | Elapsed time since the instantiation of this switch or thread.  Reset when a thread switches.
threadTime :: FRP e m () Time
threadTime = summation zero <<< deltaTime

-- | The edge detection mode.  If 'Discrete', detect edge between subsequent frames only.
-- If 'Fuzzy' detect edge since the most recent previous detected edge.
-- If 'HashedDiscrete', the comparison function is itself expensive, and the FRP runtime will compare by 'StableName's as a short-circuit optimization.
data EdgeDetectionMode = Fuzzy | Discrete

-- | Answer the most recent input that satisfies the predicate.
-- Accepts an initial value, which need not itself satisfy the predicate.
--
-- This can be a performance optimization, if it prevents unecessary evaluation of an input.
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)

-- | Answer the first input that ever passes through a function.
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")

-- | Returns 'True' only during frames on which the input has changed, based on a user-specified equality predicate.
-- The predicate function takes the most recent input as its first parameter.
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))

-- | Same as 'edge Discrete'.
changed :: (x -> x -> Bool) -> FRP e m x Bool
changed = edge Discrete

-- | Recalculate a function only at the edges of it's input.
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)