Add some stuff for chunking... Not sure if we'll use it

library/VaporTrail/Codec/Type.hs

@@ -1,12 +1,58 @@
 {-# LANGUAGE RankNTypes #-}
 module VaporTrail.Codec.Type
   ( Codec(..)
+  , toChunks
+  , fromChunks
+  , liftProcChunked
+  , liftCodecChunked
+  , lowerProcChunked
+  , lowerCodecChunked
   ) where
 
+import Control.Monad
 import Data.Machine
+import qualified Data.Vector.Generic as Vector
+import Data.Vector.Generic (Vector)
 
 data Codec a b = Codec
   { codecEnc :: Process a b
   , codecDec :: Process b a
   }
 
+toChunks :: Vector v a => Int -> Process a (v a)
+toChunks n =
+  construct . forever $ do
+    xs <- replicateM n await
+    yield (Vector.fromListN n xs)
+
+fromChunks :: Vector v a => Process (v a) a
+fromChunks = construct . forever $ do
+    chunk <- await
+    Vector.forM_ chunk yield
+
+-- | Lifts a process to operate on chunks. Less efficient than writing
+-- it to work with chunks from the start. The second argument specifies
+-- the size of the output chunks
+liftProcChunked :: (Vector v0 a, Vector v1 b) => Process a b -> Int -> Process (v0 a) (v1 b)
+liftProcChunked p n = toChunks n <~ p <~ fromChunks
+
+-- | Lifts a codec to operate on chunks. Less efficient than writing
+-- it to work with chunks from the start.
+liftCodecChunked :: (Vector v0 a, Vector v1 b) => Codec a b -> Int -> Codec (v0 a) (v1 b)
+liftCodecChunked codec n =
+  Codec
+  { codecEnc = liftProcChunked (codecEnc codec) n
+  , codecDec = liftProcChunked (codecDec codec) n
+  }
+
+-- | Lowers a process to work on individual elements. The second argument
+-- specifies the size of chunks provided to the process
+lowerProcChunked :: (Vector v0 a, Vector v1 b) => Process (v0 a) (v1 b) -> Int -> Process a b
+lowerProcChunked p n = fromChunks <~ p <~ toChunks n
+
+lowerCodecChunked :: (Vector v0 a, Vector v1 b) => Codec (v0 a) (v1 b) -> Int -> Codec a b
+lowerCodecChunked codec n =
+  Codec
+  { codecEnc = lowerProcChunked (codecEnc codec) n
+  , codecDec = lowerProcChunked (codecDec codec) n
+  }

library/VaporTrail/Filter/SignalLock.hs

@@ -1,27 +1,34 @@
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE Strict #-}
 module VaporTrail.Filter.SignalLock (lockSignal) where
 
 import VaporTrail.Filter.Fourier
 import VaporTrail.Filter.Basic
 import Data.Machine
 import Control.Monad
 import Data.Complex
+import Data.Foldable
+import Control.Category hiding ((.), id)
 
-lockChunk :: Float -> Int -> Plan (Is Float) o ([Float], Float)
+
+sigStrength :: Float -> Int -> [Float] -> Float
+sigStrength hz sampleRate xs =
+  let bin = hz / (fromIntegral sampleRate / fromIntegral dftSize)
+      s = magnitude (goertzel bin dftSize xs)
+      a = foldl' (\acc x -> acc + abs x) 0 xs / fromIntegral dftSize
+  in (s * 2) / fromIntegral dftSize / a
+
+lockChunk :: Category k => Float -> Int -> Plan (k Float) o ([Float], Float)
 lockChunk hz sampleRate = do
   c <- replicateM dftSize await
-  let bin = hz / (fromIntegral sampleRate / dftSizeF)
-      s = magnitude (goertzel bin dftSize c)
-      a = sum (map abs c) / dftSizeF
-      sigLevel = (s * 2) / dftSizeF / a
-  return (c, sigLevel)
+  return (c, sigStrength hz sampleRate c)
 
-acquireSignal :: Float -> Int -> Plan (Is Float) o ()
+acquireSignal :: Category k => Float -> Int -> Plan (k Float) o ()
 acquireSignal hz sampleRate = do
   (_, sigLevel) <- lockChunk hz sampleRate
   when (sigLevel < 0.9) (acquireSignal hz sampleRate)
 
-maintainLock :: Float -> Int -> Plan (Is Float) o [Float]
+maintainLock :: Category k => Float -> Int -> Plan (k Float) o [Float]
 maintainLock hz sampleRate = do
   (chunk, sigLevel) <- lockChunk hz sampleRate
   guard (sigLevel > 0.3)
@@ -31,21 +38,20 @@ lockedSignal :: Float -> Int -> Process Float Float
 lockedSignal hz sampleRate =
   construct $ do
     acquireSignal hz sampleRate
-    skipStartupNoise
     forever $ do
       chunk <- maintainLock hz sampleRate
       mapM_ yield chunk
 
-calcSignalNormalizer :: Plan (Is Float) Float (Float -> Float)
+calcSignalNormalizer :: Category k => Plan (k Float) Float (Float -> Float)
 calcSignalNormalizer = do
   sample <- replicateM (10 * dftSize) await
   let dco = sum sample / (dftSizeF * 10)
-      maxAmp = maximum (map (\x -> abs (x - dco)) sample)
+      maxAmp = foldl' (\prev x -> max prev (abs (x - dco))) 0 sample
       normalize x = (x - dco) / maxAmp
   mapM_ (yield . normalize) sample
   return normalize
 
-skipStartupNoise :: Plan (Is Float) o ()
+skipStartupNoise :: Category k => Plan (k Float) o ()
 skipStartupNoise = replicateM_ (10 * dftSize) await
 
 normalizedSignal :: Process Float Float

package.yaml

@@ -40,6 +40,7 @@ library:
   - bytestring
   - split
   - machines
+  - vector
   source-dirs: library
 license: GPLv2
 maintainer: Author name here