├── .gitignore ├── ChangeLog.md ├── LICENSE ├── Setup.hs ├── cabal.project ├── src ├── Prelude.hs └── Streaming │ ├── FFT.hs │ └── FFT │ └── Types.hs └── streaming-fft.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | timestamps/ts.txt 2 | run 3 | result* 4 | dist* 5 | stack.yaml 6 | .stack-work 7 | *.ghc* 8 | *.sw* 9 | *.local 10 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for streaming-fft 2 | 3 | ## 0.1.0.1 -- 2018-10-24 4 | 5 | * Documentation improvements 6 | 7 | ## 0.1.0.0 -- 2018-10-07 8 | 9 | * First version. Released on an unsuspecting world. 10 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, chessai 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of chessai nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | ../contiguous-fft 3 | -------------------------------------------------------------------------------- /src/Prelude.hs: -------------------------------------------------------------------------------- 1 | {-# language MagicHash #-} 2 | 3 | module Prelude 4 | ( module P 5 | ) where 6 | 7 | import Data.Either as P (Either(..)) 8 | import Streaming.Prelude as P (Stream, Of) 9 | import Numeric as P (pi) 10 | import Control.Monad as P (Monad(..)) 11 | import Data.Primitive.Instances () 12 | import Data.Complex as P (Complex(..)) 13 | import Control.Monad.ST as P (ST, runST) 14 | import GHC.Err as P (error) 15 | import GHC.Exts as P (Double(..),Int(..),Int#) 16 | import Data.Function as P (($), id) 17 | import Data.Bool as P (otherwise, Bool(..)) 18 | import Data.Bits as P (Bits(..)) 19 | import Data.Semigroup as P (Semigroup(..)) 20 | import Data.Monoid as P (Monoid(..)) 21 | import Control.Applicative as P (Applicative(..)) 22 | import Data.Semiring as P (Semiring(..), Ring(..), (+),(*),(-)) 23 | import Data.Int as P (Int) 24 | import Data.Word as P (Word) 25 | import GHC.Real as P (fromIntegral, (/), floor) 26 | import Data.Eq as P (Eq(..)) 27 | import Data.Ord as P (Ord(..)) 28 | import Control.Monad.Primitive as P (PrimMonad(..)) 29 | import Data.Primitive.Types as P (Prim(..)) 30 | import Data.Primitive.PrimArray as P (PrimArray,MutablePrimArray) 31 | import Data.Primitive.Contiguous as P (Contiguous,Element,Mutable) 32 | -------------------------------------------------------------------------------- /src/Streaming/FFT.hs: -------------------------------------------------------------------------------- 1 | {-# language BangPatterns #-} 2 | {-# language LambdaCase #-} 3 | {-# language MagicHash #-} 4 | {-# language ScopedTypeVariables #-} 5 | 6 | {-# OPTIONS_GHC -Wall #-} 7 | 8 | module Streaming.FFT 9 | ( -- * streaming fft 10 | streamFFT 11 | 12 | -- * Types 13 | , Transform(..) 14 | , Window(..) 15 | ) where 16 | 17 | import GHC.Classes (modInt#) 18 | import Streaming.FFT.Types 19 | import qualified Data.Complex as Complex 20 | import qualified Data.Primitive.Contiguous as Contiguous 21 | import qualified Data.Primitive.Contiguous.FFT as Contiguous 22 | import qualified Streaming.Prelude as S 23 | import Control.Monad.Trans.Class (lift) 24 | 25 | intToDouble :: Int -> Double 26 | {-# inline intToDouble #-} 27 | intToDouble = fromIntegral 28 | 29 | cissy :: Double -> Double -> Complex Double 30 | cissy k n = Complex.cis (2 * pi * k / n) 31 | 32 | windowSize :: Window -> Int 33 | windowSize = \case 34 | Window64 -> 64 35 | Window128 -> 128 36 | Window256 -> 256 37 | Window512 -> 512 38 | Window1024 -> 1024 39 | 40 | -- | Only safe when the second argument is not 0 41 | unsafeMod :: Int -> Int -> Int 42 | unsafeMod (I# x#) (I# y#) = I# (modInt# x# y#) 43 | {-# inline unsafeMod #-} -- this should happen anyway. trust but verify. 44 | 45 | -- | Compute the FFT of a previously computed FFT given a new sample. 46 | -- This operation is done in-place. 47 | -- 48 | -- /O(n)/ 49 | subFFT :: forall m. PrimMonad m 50 | => Complex Double -- ^ newest signal, x_{k+N} 51 | -> Transform m 52 | -> m () 53 | subFFT x_k_plus_N (Transform f1) = do 54 | n <- Contiguous.sizeMutable f1 55 | x_k <- Contiguous.read f1 0 56 | let go :: Int -> m () 57 | go !f = if f < n 58 | then do { 59 | atIx <- Contiguous.read f1 f 60 | ; let expTerm = cissy (intToDouble $ (n + 1) * f) (intToDouble n) 61 | res = expTerm * (atIx + x_k_plus_N - x_k) 62 | ; Contiguous.write f1 f res 63 | ; go (f + 1) 64 | } 65 | else pure () 66 | go 0 67 | 68 | loadInitial :: forall m b. (PrimMonad m) 69 | => MutablePrimArray (PrimState m) (Complex Double) 70 | -> Window -- ^ window size 71 | -> Int -- ^ index 72 | -> Int -- ^ have we finished consuming the signal 73 | -> Stream (Of (Complex Double)) m b -- ^ first part of stream 74 | -> m (Stream (Of (Complex Double)) m b) -- ^ stream minus original signal 75 | loadInitial marr sig !ix !untilSig stream = 76 | if (untilSig >= windowSize sig) 77 | then pure stream 78 | else do { 79 | S.next stream >>= \case 80 | Left _ -> pure stream 81 | Right (x,rest) -> if ix == 0 82 | then loadInitial marr sig (ix + 1) untilSig stream 83 | else do { 84 | Contiguous.write marr (unsafeMod (ix - 1 + untilSig) (windowSize sig)) x 85 | ; loadInitial marr sig (ix + 1) (untilSig + 1) rest 86 | } 87 | } 88 | 89 | thereafter :: forall m b c. (PrimMonad m) 90 | => (Transform m -> m c) 91 | -> Window 92 | -> Int -- ^ have we filled the window size 93 | -> Transform m -- ^ transform 94 | -> Stream (Of (Complex Double)) m b 95 | -> Stream (Of c) m b 96 | thereafter extract win !untilWin trans st = 97 | if (untilWin >= windowSize win) 98 | then thereafter extract win 0 trans st 99 | else do { 100 | e <- lift $ S.next st 101 | ; case e of { 102 | Left r -> pure r 103 | ; Right (x,rest) -> do { 104 | lift $ subFFT x trans 105 | ; info <- lift $ extract trans 106 | ; S.yield info 107 | ; thereafter extract win (untilWin + 1) trans rest 108 | } 109 | } 110 | } 111 | 112 | streamFFT :: forall m b c. (PrimMonad m) 113 | => (Transform m -> m c) 114 | -> Window 115 | -> Stream (Of (Complex Double)) m b 116 | -> Stream (Of c) m b 117 | streamFFT extract win stream = do 118 | -- Allocate the one array 119 | marr <- lift $ Contiguous.new (windowSize win) 120 | 121 | -- Grab the first signal from the stream 122 | streamMinusFirst <- lift $ loadInitial marr win 0 0 stream 123 | 124 | -- Get our first transform 125 | initialT :: Transform m <- lift $ do { Contiguous.mfft marr; pure $ Transform marr } 126 | 127 | -- Extract information from that transform 128 | initialInfo <- lift $ extract initialT 129 | 130 | -- Yield that information to the new stream 131 | S.yield initialInfo 132 | 133 | -- Now go 134 | thereafter extract win 0 initialT streamMinusFirst 135 | -------------------------------------------------------------------------------- /src/Streaming/FFT/Types.hs: -------------------------------------------------------------------------------- 1 | {-# language RankNTypes #-} 2 | {-# language ScopedTypeVariables #-} 3 | 4 | {-# OPTIONS_GHC -Wall #-} 5 | 6 | module Streaming.FFT.Types 7 | ( -- * types 8 | Transform(..) 9 | , Initial(..) 10 | , Window(..) 11 | ) where 12 | 13 | -- | Initial bit 14 | newtype Initial = Initial { getInitial :: forall s. MutablePrimArray s (Complex Double) } 15 | 16 | -- | Represents the result of a transform of a 'Window'. 17 | newtype Transform m = Transform { getTransform :: MutablePrimArray (PrimState m) (Complex Double) } 18 | 19 | data Window 20 | = Window64 21 | | Window128 22 | | Window256 23 | | Window512 24 | | Window1024 25 | -------------------------------------------------------------------------------- /streaming-fft.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | name: 3 | streaming-fft 4 | version: 5 | 0.2.0.0 6 | synopsis: 7 | online streaming fft 8 | description: 9 | online (in input and output) streaming fft algorithm 10 | that uses a dense-stream optimisation to reduce work 11 | from /O(n log n)/ to /O(n)/. 12 | homepage: 13 | https://github.com/chessai/streaming-fft 14 | license: 15 | BSD-3-Clause 16 | license-file: 17 | LICENSE 18 | author: 19 | chessai 20 | maintainer: 21 | chessai1996@gmail.com 22 | category: 23 | Data, Streaming, Pipes 24 | build-type: 25 | Simple 26 | extra-source-files: 27 | ChangeLog.md 28 | tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 29 | 30 | library 31 | exposed-modules: 32 | Streaming.FFT 33 | Streaming.FFT.Types 34 | other-modules: 35 | Prelude 36 | build-depends: 37 | , base-noprelude >=4.9 && <5 38 | , contiguous >= 0.3 && < 0.4 39 | , contiguous-fft >= 0.2.2 && < 0.3 40 | , ghc-prim 41 | , prettyprinter >= 1.2 && < 1.3 42 | , prim-instances 43 | , primitive >= 0.6.4 && < 0.7 44 | , refined >= 0.3 && < 0.4 45 | , semirings >= 0.3 && < 0.4 46 | , streaming >= 0.2 && < 0.3 47 | , transformers >= 0.3 && < 0.6 48 | hs-source-dirs: 49 | src 50 | default-language: 51 | Haskell2010 52 | ghc-options: 53 | -O2 54 | --------------------------------------------------------------------------------