allocated-processor 0.0.1 → 0.0.2

raw patch · 2 files changed

+81/−21 lines, 2 filesdep +vector-spacedep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: vector-space

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• allocated-processor.cabal +2/−2
• src/Control/Processor.hs +79/−19

@@ -1,5 +1,5 @@ name: allocated-processor-version: 0.0.1+version: 0.0.2 license: BSD3 maintainer: Noam Lewis <jones.noamle@gmail.com> bug-reports: mailto:jones.noamle@gmail.com@@ -16,7 +16,7 @@    exposed-modules: Control.Processor                     Foreign.ForeignPtrWrap    hs-Source-Dirs: src-   build-depends: base >= 3 && < 5+   build-depends: base >=4 && <5, vector-space    ghc-options: -Wall  -- source-repository head

@@ -1,4 +1,4 @@-{-# LANGUAGE RankNTypes, GADTs, NoMonomorphismRestriction #-}+{-# LANGUAGE RankNTypes, GADTs, NoMonomorphismRestriction, FlexibleContexts #-} -- |  -- Module      : Control.Processor -- Copyright   : (c) Noam Lewis, 2010@@ -39,6 +39,9 @@  import Control.Monad(liftM, join) +import Data.VectorSpace((^*), (*^), (^+^), (^-^), (^/), Scalar, VectorSpace, AdditiveGroup, zeroV)+import Data.Maybe(fromMaybe)+ -- | The type of Processors -- --    * @a@, @b@ = the input and output types of the processor (think a -> b)@@ -314,6 +317,7 @@ -- -- >  [[ myDeviceProcessor innerProc ]] = read >>> innerProc >>> write --+-- TODO: Find a more general / elegant solution to the "shared resource" problem. wrapProcessor :: Monad m =>                  (a -> x -> m x) -> (c -> x -> m x) ->                   (a -> m x) -> (x -> m b) -> (x -> m d) -> (x -> m ()) -> @@ -341,14 +345,32 @@            ------------------------------------------------------------- -type DTime = Double+trace :: (Show a) => IOProcessor a a+trace = processor proc alloc conv release+    where proc a _ = do+            print a+            return a+          alloc a = do+            print $ "alloc: " ++ (show a)+            return a+          conv = return+          release _ = return () -type DClock m = m Double --- | scanlT provides the primitive for performing memory-full operations on time-dependent processors, as described in <http://www.ee.bgu.ac.il/~noamle/_downloads/gaccum.pdf>.+-------------------------------------------------------------+-- | scanlT provides the primitive for performing memory-full operations on time-dependent processors, as+-- | described in <http://www.ee.bgu.ac.il/~noamle/_downloads/gaccum.pdf>. ----- /Untested/, and also doesn't implement the "limit as dt -> 0" part of the model.-scanlT :: DClock IO -> (b -> b -> DTime -> c -> c) -> c -> IOSource a b -> IOSource a c+-- /Untested/, and also doesn't implement the "limit as dt -> 0" part of the model. Currently the precision of+-- the approximation is set by the samplerate (how many times per second the resulting processor is run, the+-- more the better for precision).+--+-- scanlT and all its uses are probably most (or only?) useful in the context of Processor IO. However for+-- generality it is defined here on arbitrary Processor m.+--+-- The @Processor m a b@ argument should really be time-dependent during runtime, so it's model can't be @a ->+-- b@. Thus it is most logical to use only 'IOSource' types for the processor argument.+scanlT :: (Monad m) => m t -> (b -> b -> t -> c -> c) -> c -> Processor m a b -> Processor m a c scanlT clock transFunc initOut (Processor pf af cf rf) = processor procFunc allocFunc convFunc releaseFunc     where procFunc curIn' (prevIn, prevOut, x) = do             x' <- pf curIn' x@@ -367,20 +389,58 @@           releaseFunc (_, _, x') = rf x'                      --- | Differentiate using scanlT. TODO: test, and also generalize for any monad (trivial change of types).-differentiate :: (Real b) => DClock IO -> IOSource a b -> IOSource a Double-differentiate clock = scanlT clock diffFunc 0-    where diffFunc y' y dt _ = realToFrac (y' - y) / dt -- horrible approximation!+-- | Differentiate of time-dependent values, using 'scanlT'+differentiate :: (VectorSpace v, Fractional (Scalar v), Monad m) => m (Scalar v) -> Processor m a v -> Processor m a v+differentiate clock = scanlT clock diffFunc zeroV+    where diffFunc y' y dt _ = (y' ^-^ y) ^/ dt -- horrible approximation (unless sample rate is high)!           -integrate :: (Real b) => DClock IO -> IOSource a b -> IOSource a Double-integrate clock p = scanlT clock intFunc 0 p-    where intFunc y' y dt prevSum = prevSum + realToFrac (y' + y) * dt / 2 -- horrible approximation!+-- | Integration of time-dependent values, using 'scanlT', implemented by trapezoidal approximation.+integrate :: (VectorSpace v, Fractional (Scalar v), Monad m) => m (Scalar v) -> Processor m a v -> Processor m a v+integrate clock p = scanlT clock intFunc zeroV p+    where intFunc y' y dt prevSum = prevSum ^+^ (y' ^+^ y) ^* (dt / 2) -- horrible approximation! -max_ :: Ord b => DClock IO -> b -> IOSource a b -> IOSource a b-max_ clock minVal = scanlT clock maxFunc minVal-    where maxFunc y' y _ _ = max y' y++-- -- | Convolution, using 'integrate'. +--convolve :: (Monad m) => m (Scalar v) -> (Scalar v -> v) -> Processor m a v -> Processor m a v+--convolve clock convArg proc =+++-- | Running maximum of a processor's values+maxP :: (Ord b, Monad m) => m t -> b -> Processor m a b -> Processor m a b+maxP clock minVal = scanlT clock maxFunc minVal+    where maxFunc _ y _ y' = max y' y           -min_ :: Ord b => DClock IO -> b -> IOSource a b -> IOSource a b-min_ clock maxVal = scanlT clock minFunc maxVal-    where minFunc y' y _ _ = min y' y+-- | Running minimum of a processor's values+minP :: (Ord b, Monad m) => m t -> b -> Processor m a b -> Processor m a b+minP clock maxVal = scanlT clock minFunc maxVal+    where minFunc _ y _ y' = min y' y +++-- can only be defined for discrete time+-- t = the time steps+nStepsMemory :: (Monad m) => Int -> ([(t, b)] -> c) -> (t, b) -> c -> m t -> Processor m a b -> Processor m a c+nStepsMemory n f initA initB clock pIn = (scanlT clock f' (take n . repeat $ initA, initB) pIn) >>> arr snd+    where f' _ y2 dt (lastNSamps, _) = (nextSamps, f nextSamps )+              where nextSamps = (dt, y2) : (init lastNSamps)+++-- | Holds a Maybe-valued processor and reports the time passed since last value was seen.+holdMaybe :: (Num t, Monad m) => b -> m t -> Processor m a (Maybe b) -> Processor m a (b, t)+holdMaybe initLast clock pIn = scanlT clock f' (initLast,0) pIn+    where f' _ y2 dt (last', timeMissing) = (fromMaybe last' y2, calcTimeMissing y2 timeMissing)+              where calcTimeMissing Nothing t = t + dt+                    calcTimeMissing _       _ = 0++-- | Given a 'holdMaybe'-type processor, reverts back to a default value if no input was +-- seen for more than a given time limit+revertAfterT :: (Monad m, Ord t) => t -> b -> Processor m a (b, t) -> Processor m a b+revertAfterT maxT revertVal p = p >>> arr (\(b,t) -> if t > maxT then revertVal else b)++-- todo: this is a general function, perhaps move to a module?+discreteConv :: (VectorSpace a) => [Scalar a] -> [a] -> a+discreteConv weights samps = foldr (^+^) zeroV $ zipWith (*^) weights samps+          +-- | Finite impulse response+fir :: (Monad m, Fractional (Scalar v), VectorSpace v) => [Scalar v] -> t -> m t -> Processor m a v -> Processor m a v+fir weights initTimeStep clock pIn = nStepsMemory (length weights) (discreteConv weights . map snd) (initTimeStep, zeroV) zeroV clock pIn