diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,25 +1,42 @@ +0.2.0.4 +------- + + +* **Control.Auto**: Added `unserialize`, `delay`, and `delay_` to + `Control.Auto`'s exports. +* **Control.Auto.Blip**: New blip stream manipulator: `forkB`, which forks a + blip stream into to separate ones based on whether or not the emitted + values match a predicate. +* **Control.Auto.Time**: Added a generalized version of `stretch`, + `stretchAccumBy` which allows access to the "skipped" inputs during the + stretched periods, as well as the ability to control the outputs during + the stretched periods. + + 0.2.0.3 ------- -* Bug for `dynZipF` fixed, where newly added `Auto`s would overwrite ones - alreay stored. -* `fromInterval` added to `Control.Auto`'s exports. +* **Control.Auto.Collection**: Bug for `dynZipF` fixed, where newly added + `Auto`s would overwrite ones alreay stored. +* **Control.Auto**: `fromInterval` added to `Control.Auto`'s exports. 0.2.0.2 ------- -* `dynZipF` and `dynMapF`, self-serializing dynamic collections. +* **Control.Auto.Collection**: `dynZipF` and `dynMapF`, implicit-serialization + dynamic collections. 0.2.0.1 ------- -* `catchA` added to `Control.Auto.Effects`, allowing explicit catching of - runtime exceptions thrown in underlying `IO`. +* **Control.Auto.Effects**: `catchA` added to `Control.Auto.Effects`, + allowing explicit catching of runtime exceptions thrown in underlying + `IO`. 0.2.0.0 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -13,22 +13,22 @@ import Prelude hiding ((.), id) -- We represent a system as `System`, an `Auto` that takes stream of `Double`s --- as input and transforms it into a stream of `Double`s as output. A --- `System IO` might do IO in the process of creating its ouputs, for --- instance. +-- as input and transforms it into a stream of `Double`s as output. The `m` +-- means that a `System IO` might do IO in the process of creating its ouputs, +-- for instance. -- type System m = Auto m Double Double --- A PID controller adjusts the input to the black box system until the response --- matches the target. It does this by adjusting the input based on the --- current error, the cumulative sum, and the consecutative differences. +-- A PID controller adjusts the input to the black box system until the +-- response matches the target. It does this by adjusting the input based on +-- the current error, the cumulative sum, and the consecutative differences. -- -- See http://en.wikipedia.org/wiki/PID_controller -- -- Here, we just lay out the "concepts"/time-varying values in our system as a -- recursive/cyclic graph of dependencies. It's a feedback system, after all. -- -pid :: (Double, Double, Double) -> System m -> System m +pid :: MonadFix m => (Double, Double, Double) -> System m -> System m pid (kp, ki, kd) blackbox = proc target -> do rec -- err :: Double -- the difference of the response from the target diff --git a/auto.cabal b/auto.cabal --- a/auto.cabal +++ b/auto.cabal @@ -1,5 +1,5 @@ name: auto -version: 0.2.0.3 +version: 0.2.0.4 synopsis: Denotative, locally stateful programming DSL & platform description: (Up to date documentation is maintained at ) diff --git a/src/Control/Auto.hs b/src/Control/Auto.hs --- a/src/Control/Auto.hs +++ b/src/Control/Auto.hs @@ -48,6 +48,7 @@ , decodeAuto , readAuto , writeAuto + , unserialize -- ** Strictness , forcer , seqer @@ -95,6 +96,8 @@ , mappendFrom , lastVal , lastVal_ + , delay + , delay_ , count -- ** Switches , (-->) diff --git a/src/Control/Auto/Blip.hs b/src/Control/Auto/Blip.hs --- a/src/Control/Auto/Blip.hs +++ b/src/Control/Auto/Blip.hs @@ -57,6 +57,7 @@ , lagBlips , lagBlips_ , filterB + , forkB , joinB , mapMaybeB , takeB @@ -367,6 +368,11 @@ -- -- These bad examples would be good use cases of 'Interval'. -- +-- Can be particularly useful with prisms from the /lens/ package, where +-- things like @emitOn (has _Right)@ and @emitOn (hasn't _Right)@ will emit +-- the input @Either a b@ whenever it is or isn't a 'Right'. See +-- 'emitJusts' for more common uses with /lens/. +-- emitOn :: (a -> Bool) -- ^ predicate to emit on -> Auto m a (Blip a) emitOn p = mkFunc $ \x -> if p x then Blip x else NoBlip @@ -441,6 +447,17 @@ filterB p = mkFunc $ \x -> case x of Blip x' | p x' -> x _ -> NoBlip + +-- | "Forks" a blip stream based on a predicate. Takes in one blip stream +-- and produces two: the first emits whenever the input emits with a value +-- that passes the predicate, and the second emits whenever the input emits +-- with a value that doesn't. +forkB :: (a -> Bool) + -> Auto m (Blip a) (Blip a, Blip a) +forkB p = mkFunc $ \x -> case x of + Blip x' | p x' -> (x, NoBlip) + | otherwise -> (NoBlip, x) + _ -> (NoBlip, NoBlip) -- | "Collapses" a blip stream of blip streams into single blip stream. -- that emits whenever the inner-nested stream emits. diff --git a/src/Control/Auto/Core.hs b/src/Control/Auto/Core.hs --- a/src/Control/Auto/Core.hs +++ b/src/Control/Auto/Core.hs @@ -291,6 +291,11 @@ -- | Generalizes an @'Auto'' a b@ to an @'Auto' m a b'@ for any 'Monad' -- @m@, using 'hoist'. -- +-- You generally should be able to avoid using this if you never directly +-- write any 'Auto''s and always write 'Auto m' parameterized over all +-- 'Monad's, but...in case you import one from a library or something, you +-- can use this. +-- generalizeA :: Monad m => Auto' a b -> Auto m a b generalizeA = hoistA (return . runIdentity) diff --git a/src/Control/Auto/Time.hs b/src/Control/Auto/Time.hs --- a/src/Control/Auto/Time.hs +++ b/src/Control/Auto/Time.hs @@ -53,6 +53,8 @@ , stretch , stretch_ , stretchB + , stretchAccumBy + , stretchAccumBy_ -- ** Accelerating , accelerate , accelerateWith @@ -74,6 +76,7 @@ import Control.Monad import Control.Monad.Trans.Class import Control.Monad.Trans.Writer +import Data.Maybe import Data.Monoid import Data.Serialize import Prelude hiding ((.), id) @@ -216,17 +219,7 @@ => Int -- ^ stretching factor -> Auto m a b -- ^ 'Auto' to stretch -> Auto m a b -stretch n = go (1, undefined) - where - go (i, y) a = mkAutoM (go <$> get <*> resumeAuto a) - (put (i, y) *> saveAuto a) - $ \x -> - if i <= 1 - then do - (y', a') <- stepAuto a x - return (y', go (n , y') a') - else - return (y , go (i - 1, y ) a ) +stretch = stretchBy id -- | The non-resuming/non-serializing version of 'stretch'. @@ -234,15 +227,98 @@ => Int -- ^ stretching factor -> Auto m a b -- ^ 'Auto' to stretch -> Auto m a b -stretch_ n = go (1, undefined) +stretch_ = stretchBy_ id + +stretchBy :: (Serialize b, Monad m) + => (b -> b) + -> Int + -> Auto m a b + -> Auto m a b +stretchBy f n = go (1, Nothing) where + go (i, y) a = mkAutoM (go <$> get <*> resumeAuto a) + (put (i, y) *> saveAuto a) + $ \x -> + if i <= 1 + then do + (y', a') <- stepAuto a x + return (y', go (n, Just y') a') + else + return (f (fromJust y), go (i - 1, y) a) + +stretchBy_ :: (Monad m) + => (b -> b) + -> Int + -> Auto m a b + -> Auto m a b +stretchBy_ f n = go (1, Nothing) + where go (i, y) a = mkAutoM_ $ \x -> if i <= 1 then do (y', a') <- stepAuto a x - return (y, go (n , y') a') + return (y', go (n, Just y') a') else - return (y, go (i - 1, y ) a ) + return (f (fromJust y), go (i - 1, y) a) + +-- | A more general version of 'stretch'; instead of just ignoring and +-- dropping the "stretched/skipped intervals", accumulate all of them up +-- with the given accumulating function and then "step" them all at once on +-- every @n@th tick. Also, stead of returning exactly the same output +-- every time over the stretched interval, output a function of the +-- original output during the stretched intervals. +-- +-- >>> streamAuto' (sumFrom 0) [1..10] +-- [1, 3, 6, 10, 15, 21, 28, 36, 45 ,55] +-- >>> streamAuto' (stretchAccumBy (+) negate 4 (sumFrom 0)) [1..10] +-- [1,-1,-1, -1, 15,-15,-15,-15, 45,-45] +-- +-- Here, instead of feeding in a number every step, it "accumulates" all of +-- the inputs using '+' and "blasts them into" @'sumFrom' 0@ every 4 steps. +-- In between the blasts, it outputs the negated last seen result. +-- +-- You can recover the behavior of 'stretch' with +-- @'stretchAccumBy' (flip const) id@. +-- +stretchAccumBy :: (Serialize a, Serialize b, Monad m) + => (a -> a -> a) + -> (b -> b) + -> Int + -> Auto m a b + -> Auto m a b +stretchAccumBy fx fy n = go (1, Nothing, Nothing) + where + go (i, x0, y) a = mkAutoM (go <$> get <*> resumeAuto a) + (put (i, x0, y) *> saveAuto a) + $ \x -> + if i <= 1 + then do + (y', a') <- stepAuto a . fromJust $ acm x0 x + return (y', go (n, Nothing, Just y') a') + else + return (fy (fromJust y), go (i-1, acm x0 x, y) a) + acm Nothing x = Just x + acm (Just x) y = Just (fx x y) + +-- | The non-serialized/non-resuming version of 'stretchAccumBy'. +stretchAccumBy_ :: Monad m + => (a -> a -> a) + -> (b -> b) + -> Int + -> Auto m a b + -> Auto m a b +stretchAccumBy_ fx fy n = go (1, Nothing, Nothing) + where + go (i, x0, y) a = mkAutoM_ $ \x -> + if i <= 1 + then do + (y', a') <- stepAuto a . fromJust $ acm x0 x + return (y', go (n, Nothing, Just y') a') + else + return (fy (fromJust y), go (i-1, acm x0 x, y) a) + acm Nothing x = Just x + acm (Just x) y = Just (fx x y) + -- | Like 'stretch', but instead of holding the the "stretched" outputs, -- outputs a blip stream that emits every time the stretched 'Auto'