Yampa-0.9.1.2: Library for programming hybrid systems.Source codeContentsIndex
AFRP
Portabilitynon-portable (uses GHC extensions)
Stabilityprovisional
Maintainerantony@apocalypse.org
Description

The AFRP core.

ToDo: * Check embedSynch for space leaks. It might be a good idea to force dropped frames. * The internal streamToSignal is interesting, and a version somehow accepting a time stamped stream/assuming equidistant samples, possibly with an interpolation function, might be even more interesting. Perhaps consider a version that applies cycle to the supplied list? Note that there is a relation to embedSynch since a partial application of embedSynch to identity would yield something similar. Or it is in some sense the inverse of embed. * It seems the use of VectorSpace-based integrals causes more ambiguity problems than before. Investigate (comments in AFRPTest.hs). * Maybe now, after, repeatedly should return (). There could be a bunch of utilities nowTag, afterTag, repeatedlyTag, and edgeTag. Decide based on API consistency. E.g. edge already returns (). * Reconsider the semantics of edgeBy. Does not disallow an edge condition that persists between consecutive samples. OTOH, consider a signal that alternates between two discrete values (True, False, say). Surely we could then see edges on every sample. It's not really for us to say whether the edge detecting function does a good job or not? * We should probably introduce a type synonym Frequency here. It might be most natural to give some parameters in terms of frequency (like for repeatedly and occasionally). On the other hand, there is after, and it would be good if after and repeatedly are mutually consitent, if repeatedly and occsaionally are consitent, and if the user knows that Time is the only dimension he or she needs to worry about. * Here's an argument for why now, after, etc. should return (). The event value has to be a static entity anyway in these cases. So, if we need them to something DYNAMIC, then the extra argument is useless. Or if we don't care. If it is decided to change the interface in that way, I guess we could also change Time to Frequency where that makes sense. On the other hand, what's the point of now always returning ()? Would one not usually want to say what to return? If yes, then There is something to be said for making after consitent with now. After all, we should have now = after 0. * Maybe reactimate should be parameterized on the monad type? * Revisit the reactimate interfaces along with embedding. * Revisit integration and differentiation. Valery suggests:

integral :: VectorSpace a s => SF a a integral = ( a _ dt v -> v ^+^ realToFrac dt *^ a) iterFrom zeroVector

  • - non-delayed integration (using the function's value at the current -- time) ndIntegral :: VectorSpace a s => SF a a ndIntegral = ( _ a' dt v -> v ^+^ realToFrac dt *^ a') iterFrom zeroVector

derivative :: VectorSpace a s => SF a a derivative = ( a a' dt _ -> (a' ^-^ a) ^/ realToFrac dt) iterFrom zeroVector

iterFrom :: (a -> a -> DTime -> b -> b) -> b -> SF a b f iterFrom b = SF (iterAux b) where iterAux b a = (SFTIVar ( dt a' -> iterAux (f a a' dt b) a'), b) See also the original e-mail discussion.

Documentation
module AFRPVectorSpace
(#) :: (a -> b) -> (b -> c) -> a -> cSource
dup :: a -> (a, a)Source
swap :: (a, b) -> (b, a)Source
type Time = DoubleSource
data SF a b Source
show/hide Instances
data Event a Source
Constructors
NoEvent
Event a
show/hide Instances
identity :: SF a aSource
constant :: b -> SF a bSource
localTime :: SF a TimeSource
time :: SF a TimeSource
(-->) :: b -> SF a b -> SF a bSource
(>--) :: a -> SF a b -> SF a bSource
(-=>) :: (b -> b) -> SF a b -> SF a bSource
(>=-) :: (a -> a) -> SF a b -> SF a bSource
initially :: a -> SF a aSource
never :: SF a (Event b)Source
now :: b -> SF a (Event b)Source
after :: Time -> b -> SF a (Event b)Source
repeatedly :: Time -> b -> SF a (Event b)Source
afterEach :: [(Time, b)] -> SF a (Event b)Source
edge :: SF Bool (Event ())Source
iEdge :: Bool -> SF Bool (Event ())Source
edgeTag :: a -> SF Bool (Event a)Source
edgeJust :: SF (Maybe a) (Event a)Source
edgeBy :: (a -> a -> Maybe b) -> a -> SF a (Event b)Source
notYet :: SF (Event a) (Event a)Source
once :: SF (Event a) (Event a)Source
takeEvents :: Int -> SF (Event a) (Event a)Source
dropEvents :: Int -> SF (Event a) (Event a)Source
switch :: SF a (b, Event c) -> (c -> SF a b) -> SF a bSource
dSwitch :: SF a (b, Event c) -> (c -> SF a b) -> SF a bSource
rSwitch :: SF a b -> SF (a, Event (SF a b)) bSource
drSwitch :: SF a b -> SF (a, Event (SF a b)) bSource
kSwitch :: SF a b -> SF (a, b) (Event c) -> (SF a b -> c -> SF a b) -> SF a bSource
dkSwitch :: SF a b -> SF (a, b) (Event c) -> (SF a b -> c -> SF a b) -> SF a bSource
parB :: Functor col => col (SF a b) -> SF a (col b)Source
pSwitchB :: Functor col => col (SF a b) -> SF (a, col b) (Event c) -> (col (SF a b) -> c -> SF a (col b)) -> SF a (col b)Source
dpSwitchB :: Functor col => col (SF a b) -> SF (a, col b) (Event c) -> (col (SF a b) -> c -> SF a (col b)) -> SF a (col b)Source
rpSwitchB :: Functor col => col (SF a b) -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)Source
drpSwitchB :: Functor col => col (SF a b) -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)Source
par :: Functor col => (forall sf. a -> col sf -> col (b, sf)) -> col (SF b c) -> SF a (col c)Source
pSwitch :: Functor col => (forall sf. a -> col sf -> col (b, sf)) -> col (SF b c) -> SF (a, col c) (Event d) -> (col (SF b c) -> d -> SF a (col c)) -> SF a (col c)Source
dpSwitch :: Functor col => (forall sf. a -> col sf -> col (b, sf)) -> col (SF b c) -> SF (a, col c) (Event d) -> (col (SF b c) -> d -> SF a (col c)) -> SF a (col c)Source
rpSwitch :: Functor col => (forall sf. a -> col sf -> col (b, sf)) -> col (SF b c) -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)Source
drpSwitch :: Functor col => (forall sf. a -> col sf -> col (b, sf)) -> col (SF b c) -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)Source
hold :: a -> SF (Event a) aSource
trackAndHold :: a -> SF (Maybe a) aSource
accum :: a -> SF (Event (a -> a)) (Event a)Source
accumBy :: (b -> a -> b) -> b -> SF (Event a) (Event b)Source
accumFilter :: (c -> a -> (c, Maybe b)) -> c -> SF (Event a) (Event b)Source
iPre :: a -> SF a aSource
integral :: VectorSpace a s => SF a aSource
derivative :: VectorSpace a s => SF a aSource
imIntegral :: VectorSpace a s => a -> SF a aSource
loopPre :: c -> SF (a, c) (b, c) -> SF a bSource
loopIntegral :: VectorSpace c s => SF (a, c) (b, c) -> SF a bSource
noEvent :: Event aSource
noEventFst :: (Event a, b) -> (Event c, b)Source
noEventSnd :: (a, Event b) -> (a, Event c)Source
event :: a -> (b -> a) -> Event b -> aSource
fromEvent :: Event a -> aSource
isEvent :: Event a -> BoolSource
isNoEvent :: Event a -> BoolSource
tag :: Event a -> b -> Event bSource
attach :: Event a -> b -> Event (a, b)Source
lMerge :: Event a -> Event a -> Event aSource
rMerge :: Event a -> Event a -> Event aSource
merge :: Event a -> Event a -> Event aSource
mergeBy :: (a -> a -> a) -> Event a -> Event a -> Event aSource
mapMerge :: (a -> c) -> (b -> c) -> (a -> b -> c) -> Event a -> Event b -> Event cSource
mergeEvents :: [Event a] -> Event aSource
catEvents :: [Event a] -> Event [a]Source
joinE :: Event a -> Event b -> Event (a, b)Source
splitE :: Event (a, b) -> (Event a, Event b)Source
filterE :: (a -> Bool) -> Event a -> Event aSource
mapFilterE :: (a -> Maybe b) -> Event a -> Event bSource
gate :: Event a -> Bool -> Event aSource
noise :: (RandomGen g, Random b) => g -> SF a bSource
noiseR :: (RandomGen g, Random b) => (b, b) -> g -> SF a bSource
occasionally :: RandomGen g => g -> Time -> b -> SF a (Event b)Source
reactimate :: IO a -> (Bool -> IO (DTime, Maybe a)) -> (Bool -> b -> IO Bool) -> SF a b -> IO ()Source
type ReactHandle a b = IORef (ReactState a b)Source
reactInit :: IO a -> (ReactHandle a b -> Bool -> b -> IO Bool) -> SF a b -> IO (ReactHandle a b)Source
react :: ReactHandle a b -> (DTime, Maybe a) -> IO BoolSource
type DTime = DoubleSource
embed :: SF a b -> (a, [(DTime, Maybe a)]) -> [b]Source
embedSynch :: SF a b -> (a, [(DTime, Maybe a)]) -> SF Double bSource
deltaEncode :: Eq a => DTime -> [a] -> (a, [(DTime, Maybe a)])Source
deltaEncodeBy :: (a -> a -> Bool) -> DTime -> [a] -> (a, [(DTime, Maybe a)])Source
Produced by Haddock version 2.3.0