diff --git a/allocated-processor.cabal b/allocated-processor.cabal --- a/allocated-processor.cabal +++ b/allocated-processor.cabal @@ -1,5 +1,5 @@ name: allocated-processor -version: 0.0.1 +version: 0.0.2 license: BSD3 maintainer: Noam Lewis 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 diff --git a/src/Control/Processor.hs b/src/Control/Processor.hs --- a/src/Control/Processor.hs +++ b/src/Control/Processor.hs @@ -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 . +------------------------------------------------------------- +-- | scanlT provides the primitive for performing memory-full operations on time-dependent processors, as +-- | described in . -- --- /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