{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Rank2Types #-} module Test.Synthesizer.LLVM.Filter (tests) where import qualified Synthesizer.LLVM.Filter.Allpass as Allpass import qualified Synthesizer.LLVM.Filter.FirstOrder as FirstOrder import qualified Synthesizer.LLVM.Filter.SecondOrder as SecondOrder import qualified Synthesizer.LLVM.Filter.SecondOrderPacked as SecondOrderP import qualified Synthesizer.LLVM.Filter.Universal as UniFilter import qualified Synthesizer.LLVM.Filter.Moog as Moog import qualified Synthesizer.LLVM.Filter.ComplexFirstOrder as ComplexFilter import qualified Synthesizer.LLVM.Filter.ComplexFirstOrderPacked as ComplexFilterP import qualified Synthesizer.Plain.Filter.Recursive.Allpass as AllpassCore import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as FirstOrderCore import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilterCore import qualified Synthesizer.Plain.Filter.Recursive.Moog as MoogCore import qualified Synthesizer.Plain.Filter.Recursive.FirstOrderComplex as ComplexFilterCore import qualified Synthesizer.LLVM.Parameter as Param import qualified LLVM.Extra.Memory as Memory import qualified Synthesizer.LLVM.Wave as Wave import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS import qualified Synthesizer.LLVM.Parameterized.Signal as SigP import Synthesizer.LLVM.CausalParameterized.Process (($<), ($*), ) import Synthesizer.LLVM.Parameterized.Signal (($#), ) import Synthesizer.Plain.Filter.Recursive (Pole(Pole)) -- import qualified Synthesizer.Storable.Signal as SigSt import qualified Synthesizer.Interpolation.Module as Ip import qualified Synthesizer.Causal.Interpolation as InterpC import qualified Synthesizer.Causal.Filter.NonRecursive as FiltC import qualified Synthesizer.Causal.Displacement as DispC import qualified Synthesizer.Causal.Process as CausalS import qualified Synthesizer.Basic.Wave as WaveCore import qualified Synthesizer.State.Displacement as DispS import qualified Synthesizer.State.Oscillator as OsciS import qualified Synthesizer.State.Signal as SigS import qualified Synthesizer.Basic.Phase as Phase import qualified Data.StorableVector.Lazy as SVL import Data.StorableVector.Lazy (ChunkSize, ) import Test.Synthesizer.LLVM.Utility (checkSimilarity, checkSimilarityState, rangeFromInt, ) import qualified Control.Category as Cat import Control.Category ((<<<), ) import Control.Arrow ((&&&), (^<<), (<<^), ) import LLVM.Core (Value, Vector, ) import qualified LLVM.Core as LLVM import qualified Data.TypeLevel.Num as TypeNum import Data.TypeLevel.Num (D4, ) import qualified Number.Complex as Complex import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import Test.QuickCheck (quickCheck, ) import NumericPrelude.Numeric import NumericPrelude.Base signalLength :: Int signalLength = 10000 limitFloat :: SVL.Vector Float -> SVL.Vector Float limitFloat = SVL.take signalLength {- limitStereoFloat :: SVL.Vector (Stereo.T Float) -> SVL.Vector (Stereo.T Float) limitStereoFloat = SVL.take signalLength -} lfoSine :: (Memory.C a ap, LLVM.IsSized ap asize) => (forall r. Value Float -> LLVM.CodeGenFunction r a) -> Param.T p Float -> SigP.T p a lfoSine f reduct = SigP.interpolateConstant reduct $ SigP.mapSimple f $ CausalP.apply (CausalP.mapExponential 2 0.01) $ SigP.osciSimple Wave.sine 0 (fmap (* (0.1/44100)) reduct) allpassControl :: (TypeNum.Nat n) => n -> Param.T p Float -> SigP.T p (Allpass.CascadeParameter n (Value Float)) allpassControl order = lfoSine (Allpass.flangerParameter order) allpassPhaserCausal, allpassPhaserPipeline :: Param.T p Float -> SigP.T p (Value Float) -> SigP.T p (Value Float) allpassPhaserCausal reduct = CausalP.apply (Allpass.phaserP $< allpassControl TypeNum.d16 reduct) allpassPhaserPipeline reduct xs = let order = TypeNum.d16 in (SigP.drop $# TypeNum.toInt order) $ (Allpass.phaserPipelineP $< allpassControl order reduct $* xs) allpassPipeline :: IO (ChunkSize -> ((Int,Int), Int) -> Bool) allpassPipeline = let freq = rangeFromInt (0.001, 0.01) <<^ fst . fst phase = rangeFromInt (0, 0.99) <<^ snd . fst reduct = rangeFromInt (10, 100) <<^ snd tone = SigP.osciSimple Wave.triangle phase freq in checkSimilarity 1e-2 limitFloat (allpassPhaserCausal reduct tone) (allpassPhaserPipeline reduct tone) {- | Shrink control signal in time since we can only handle one control parameter per vector chunk. -} applyPacked :: (Memory.C c cp, LLVM.IsSized cp cs) => CausalP.T p (c, Value (Vector D4 Float)) (Value (Vector D4 Float)) -> SigP.T p c -> SigP.T p (Value (Vector D4 Float)) -> SigP.T p (Value (Vector D4 Float)) applyPacked proc cs xs = proc $< ((SigP.interpolateConstant $# (recip $ TypeNum.toNum TypeNum.d4 :: Float)) cs) $* xs allpassPhaserPacked :: Param.T p Float -> SigP.T p (Value (Vector D4 Float)) -> SigP.T p (Value (Vector D4 Float)) allpassPhaserPacked reduct = applyPacked Allpass.phaserPackedP (allpassControl TypeNum.d16 reduct) allpassPacked :: IO (ChunkSize -> ((Int,Int), Int) -> Bool) allpassPacked = let freq = rangeFromInt (0.001, 0.01) <<^ fst . fst phase = rangeFromInt (0, 0.99) <<^ snd . fst reduct = (4*) ^<< rangeFromInt (1, 25) <<^ snd tone = SigP.osciSimple Wave.triangle phase freq toneP = SigPS.osciSimple Wave.triangle phase freq in checkSimilarity 1e-2 limitFloat (allpassPhaserCausal reduct tone) (SigPS.unpack $ allpassPhaserPacked reduct toneP) interpolateConstant :: Float -> SigS.T a -> SigS.T a interpolateConstant reduct xs = CausalS.apply (InterpC.relative Ip.constant 0 xs) $ SigS.repeat $ recip reduct {-# INLINE lfoSineCore #-} lfoSineCore :: (Float -> a) -> Float -> SigS.T a lfoSineCore f reduct = interpolateConstant reduct $ SigS.map f $ DispS.mapExponential 2 0.01 $ OsciS.static WaveCore.sine zero (reduct * 0.1/44100) {-# INLINE allpassPhaserCore #-} allpassPhaserCore :: Float -> SigS.T Float -> SigS.T Float allpassPhaserCore reduct = let order = 16 in CausalS.apply $ FiltC.amplify 0.5 <<< DispC.mix <<< ((CausalS.applyFst (AllpassCore.cascadeCausal order) $ lfoSineCore (AllpassCore.flangerParameter order) reduct) &&& Cat.id) allpassCore :: IO (ChunkSize -> ((Int,Int), Int) -> Bool) allpassCore = let freq = rangeFromInt (0.001, 0.01) <<^ fst . fst phase = rangeFromInt (0, 0.99) <<^ snd . fst reduct = rangeFromInt (10, 100) <<^ snd tone = SigP.osciSimple Wave.triangle phase freq toneS p = OsciS.static WaveCore.triangle (Phase.fromRepresentative (Param.get phase p)) (Param.get freq p) in checkSimilarityState 1e-2 limitFloat (allpassPhaserCausal reduct tone) (\p -> allpassPhaserCore (Param.get reduct p) (toneS p)) diracImpulse :: SigP.T p (Value Float) diracImpulse = (CausalP.delay1 $# (one::Float)) $* (SigP.constant $# (zero::Float)) firstOrderConstant :: Param.T p Float -> SigP.T p (Value Float) -> SigP.T p (Value Float) firstOrderConstant cutOff xs = FirstOrder.lowpassCausalP $< SigP.constant (FirstOrderCore.parameter ^<< cutOff) $* xs firstOrderExponential :: IO (ChunkSize -> (Int,Int) -> Bool) firstOrderExponential = let cutOff = rangeFromInt (0.001, 0.01) <<^ fst gain = exp(-2*pi*cutOff) in checkSimilarity 1e-2 limitFloat (SigP.amplify (recip (1 - gain)) $ firstOrderConstant cutOff diracImpulse) (SigP.exponentialCore gain $# (one :: Float)) firstOrderCausal :: Param.T p Float -> SigP.T p (Value Float) -> SigP.T p (Value Float) firstOrderCausal reduct xs = FirstOrder.lowpassCausalP $< lfoSine FirstOrder.parameter reduct $* xs {-# INLINE firstOrderCore #-} firstOrderCore :: Float -> SigS.T Float -> SigS.T Float firstOrderCore reduct = CausalS.apply $ CausalS.applyFst FirstOrderCore.lowpassCausal $ lfoSineCore FirstOrderCore.parameter reduct firstOrder :: IO (ChunkSize -> ((Int,Int), Int) -> Bool) firstOrder = let freq = rangeFromInt (0.001, 0.01) <<^ fst . fst phase = rangeFromInt (0, 0.99) <<^ snd . fst reduct = rangeFromInt (10, 100) <<^ snd tone = SigP.osciSimple Wave.triangle phase freq toneS p = OsciS.static WaveCore.triangle (Phase.fromRepresentative (Param.get phase p)) (Param.get freq p) in checkSimilarityState 1e-2 limitFloat (firstOrderCausal reduct tone) (\p -> firstOrderCore (Param.get reduct p) (toneS p)) firstOrderCausalPacked :: Param.T p Float -> SigP.T p (Value (Vector D4 Float)) -> SigP.T p (Value (Vector D4 Float)) firstOrderCausalPacked reduct = applyPacked (FirstOrder.lowpassCausalPackedP) (lfoSine FirstOrder.parameter reduct) firstOrderPacked :: IO (ChunkSize -> ((Int,Int), Int) -> Bool) firstOrderPacked = let freq = rangeFromInt (0.001, 0.01) <<^ fst . fst phase = rangeFromInt (0, 0.99) <<^ snd . fst reduct = (4*) ^<< rangeFromInt (1, 25) <<^ snd tone = SigP.osciSimple Wave.triangle phase freq toneP = SigPS.osciSimple Wave.triangle phase freq in checkSimilarity 1e-2 limitFloat (firstOrderCausal reduct tone) (SigPS.unpack $ firstOrderCausalPacked reduct toneP) secondOrderCausal :: Param.T p Float -> SigP.T p (Value Float) -> SigP.T p (Value Float) secondOrderCausal reduct xs = SecondOrder.causalP $< lfoSine (SecondOrder.bandpassParameter (LLVM.valueOf (10::Float))) reduct $* xs secondOrderCausalPacked :: Param.T p Float -> SigP.T p (Value (Vector D4 Float)) -> SigP.T p (Value (Vector D4 Float)) secondOrderCausalPacked reduct = applyPacked SecondOrder.causalPackedP (lfoSine (SecondOrder.bandpassParameter (LLVM.valueOf (10::Float))) reduct) secondOrderPacked :: IO (ChunkSize -> ((Int,Int), Int) -> Bool) secondOrderPacked = let freq = rangeFromInt (0.001, 0.01) <<^ fst . fst phase = rangeFromInt (0, 0.99) <<^ snd . fst reduct = (4*) ^<< rangeFromInt (1, 25) <<^ snd tone = SigP.osciSimple Wave.triangle phase freq toneP = SigPS.osciSimple Wave.triangle phase freq in checkSimilarity 1e-2 limitFloat (secondOrderCausal reduct tone) (SigPS.unpack $ secondOrderCausalPacked reduct toneP) secondOrderCausalPacked2 :: Param.T p Float -> SigP.T p (Value Float) -> SigP.T p (Value Float) secondOrderCausalPacked2 reduct xs = SecondOrderP.causalP $< lfoSine (SecondOrderP.bandpassParameter (LLVM.valueOf (10::Float))) reduct $* xs secondOrderPacked2 :: IO (ChunkSize -> ((Int,Int), Int) -> Bool) secondOrderPacked2 = let freq = rangeFromInt (0.001, 0.01) <<^ fst . fst phase = rangeFromInt (0, 0.99) <<^ snd . fst reduct = rangeFromInt (10, 100) <<^ snd tone = SigP.osciSimple Wave.triangle phase freq in checkSimilarity 1e-2 limitFloat (secondOrderCausal reduct tone) (secondOrderCausalPacked2 reduct tone) {- limitUniFilter :: SVL.Vector (UniFilterCore.Result Float) -> SVL.Vector (UniFilterCore.Result Float) limitUniFilter = SVL.take signalLength -} universalCausal :: Param.T p Float -> SigP.T p (Value Float) -> SigP.T p (UniFilter.Result (Value Float)) universalCausal reduct xs = UniFilter.causalP $< lfoSine (UniFilter.parameter (LLVM.valueOf (10::Float))) reduct $* xs {-# INLINE universalCore #-} universalCore :: Float -> SigS.T Float -> SigS.T (UniFilterCore.Result Float) universalCore reduct = CausalS.apply $ CausalS.applyFst UniFilterCore.causal $ lfoSineCore (UniFilterCore.parameter . Pole 10) reduct universal :: IO (ChunkSize -> ((Int,Int), Int) -> Bool) universal = let freq = rangeFromInt (0.001, 0.01) <<^ fst . fst phase = rangeFromInt (0, 0.99) <<^ snd . fst reduct = rangeFromInt (10, 100) <<^ snd tone = SigP.osciSimple Wave.triangle phase freq toneS p = OsciS.static WaveCore.triangle (Phase.fromRepresentative (Param.get phase p)) (Param.get freq p) in checkSimilarityState 1e-2 limitFloat (fmap UniFilter.lowpass $ universalCausal reduct tone) (\p -> SigS.map UniFilterCore.lowpass $ universalCore (Param.get reduct p) (toneS p)) {- checkSimilarityState 1e-2 limitUniFilter (universalCausal reduct tone) (\p -> universalCore (Param.get reduct p) (toneS p)) -} moogCausal :: (TypeNum.Nat n) => n -> Param.T p Float -> SigP.T p (Value Float) -> SigP.T p (Value Float) moogCausal order reduct xs = Moog.causalP $< lfoSine (Moog.parameter order (LLVM.valueOf (10::Float))) reduct $* xs {-# INLINE moogCore #-} moogCore :: Int -> Float -> SigS.T Float -> SigS.T Float moogCore order reduct = CausalS.apply $ CausalS.applyFst (MoogCore.lowpassCausal order) $ lfoSineCore (MoogCore.parameter order . Pole 10) reduct moog :: IO (ChunkSize -> ((Int,Int), Int) -> Bool) moog = let freq = rangeFromInt (0.001, 0.01) <<^ fst . fst phase = rangeFromInt (0, 0.99) <<^ snd . fst reduct = rangeFromInt (10, 100) <<^ snd order = TypeNum.d6 tone = SigP.osciSimple Wave.triangle phase freq toneS p = OsciS.static WaveCore.triangle (Phase.fromRepresentative (Param.get phase p)) (Param.get freq p) in checkSimilarityState 1e-2 limitFloat (moogCausal order reduct tone) (\p -> moogCore (TypeNum.toInt order) (Param.get reduct p) (toneS p)) complexCausal :: Param.T p Float -> SigP.T p (Value Float) -> SigP.T p (Stereo.T (Value Float)) complexCausal reduct = CausalP.apply $ (ComplexFilter.causalP $< lfoSine (ComplexFilter.parameter (LLVM.valueOf (10::Float))) reduct) <<^ (\x -> Stereo.cons x (LLVM.value LLVM.zero)) complexCausalPacked :: Param.T p Float -> SigP.T p (Value Float) -> SigP.T p (Stereo.T (Value Float)) complexCausalPacked reduct = CausalP.apply $ (ComplexFilterP.causalP $< lfoSine (ComplexFilterP.parameter (LLVM.valueOf (10::Float))) reduct) <<^ (\x -> Stereo.cons x (LLVM.value LLVM.zero)) complexPacked :: IO (ChunkSize -> ((Int,Int), Int) -> Bool) complexPacked = let freq = rangeFromInt (0.001, 0.01) <<^ fst . fst phase = rangeFromInt (0, 0.99) <<^ snd . fst reduct = rangeFromInt (10, 100) <<^ snd tone = SigP.osciSimple Wave.triangle phase freq in checkSimilarity 1e-2 limitFloat (fmap Stereo.left $ complexCausal reduct tone) (fmap Stereo.left $ complexCausalPacked reduct tone) {-# INLINE complexCore #-} complexCore :: Float -> SigS.T Float -> SigS.T (Stereo.T Float) complexCore reduct = CausalS.apply $ (\x -> Stereo.cons (Complex.real x) (Complex.imag x)) ^<< CausalS.applyFst ComplexFilterCore.causal (lfoSineCore (ComplexFilterCore.parameter . Pole 10) reduct) complex :: IO (ChunkSize -> ((Int,Int), Int) -> Bool) complex = let freq = rangeFromInt (0.001, 0.01) <<^ fst . fst phase = rangeFromInt (0, 0.99) <<^ snd . fst reduct = rangeFromInt (10, 100) <<^ snd tone = SigP.osciSimple Wave.triangle phase freq toneS p = OsciS.static WaveCore.triangle (Phase.fromRepresentative (Param.get phase p)) (Param.get freq p) in checkSimilarityState 1e-2 limitFloat (fmap Stereo.left $ complexCausal reduct tone) (\p -> SigS.map ((0.1*) . Stereo.left) $ complexCore (Param.get reduct p) (toneS p)) {- in checkSimilarityState 1e-2 limitStereoFloat (complexCausal reduct tone) (\p -> complexCore (Param.get reduct p) (toneS p)) -} tests :: [(String, IO ())] tests = ("secondOrderPacked", quickCheck =<< secondOrderPacked) : ("secondOrderPacked2", quickCheck =<< secondOrderPacked2) : ("firstOrderExponential", quickCheck =<< firstOrderExponential) : ("firstOrder", quickCheck =<< firstOrder) : ("firstOrderPacked", quickCheck =<< firstOrderPacked) : ("universal", quickCheck =<< universal) : ("allpassPacked", quickCheck =<< allpassPacked) : ("allpassPipeline", quickCheck =<< allpassPipeline) : ("allpassCore", quickCheck =<< allpassCore) : ("moog", quickCheck =<< moog) : ("complexPacked", quickCheck =<< complexPacked) : ("complex", quickCheck =<< complex) : []