{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeFamilies #-} {-# 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.LLVM.Filter.NonRecursive as FiltNR 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.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.Parameter as Param 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.Parameter (($#), ) 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 qualified Data.StorableVector as SV import Data.StorableVector.Lazy (ChunkSize, ) import Test.Synthesizer.LLVM.Utility (checkSimilarity, checkSimilarityState, rangeFromInt, CheckSimilarity, CheckSimilarityState, ) import qualified Control.Category as Cat import Control.Category ((<<<), ) import Control.Arrow (arr, (&&&), (***), (^<<), (<<^), ) import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Memory as Memory import LLVM.Core (Value, ) import qualified LLVM.Core as LLVM import qualified Types.Data.Bool as TypeBool import qualified Types.Data.Num as TypeNum import Types.Data.Num (D4, ) import qualified Number.Complex as Complex import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified System.Random as Rnd import Data.Word (Word32, ) import Test.QuickCheck (quickCheck, ) import NumericPrelude.Numeric import NumericPrelude.Base type SimFloat = CheckSimilarity Float type SimStateFloat = CheckSimilarityState Float type VectorValue = Serial.Value D4 Float 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) => (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.NaturalT 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.phaser $< allpassControl TypeNum.d16 reduct) allpassPhaserPipeline reduct xs = let order = TypeNum.d16 in (SigP.drop $# TypeNum.fromIntegerT order) $ (Allpass.phaserPipeline $< allpassControl order reduct $* xs) allpassPipeline :: IO (ChunkSize -> ((Int,Int), Int) -> SimFloat) allpassPipeline = let freq = rangeFromInt (0.001, 0.01) <<^ fst . fst phase = rangeFromInt (0, 0.99 :: Float) <<^ 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) => CausalP.T p (c, VectorValue) VectorValue -> SigP.T p c -> SigP.T p VectorValue -> SigP.T p VectorValue applyPacked proc cs xs = proc $< ((SigP.interpolateConstant $# (recip $ TypeNum.fromIntegerT TypeNum.d4 :: Float)) cs) $* xs allpassPhaserPacked :: Param.T p Float -> SigP.T p VectorValue -> SigP.T p VectorValue allpassPhaserPacked reduct = applyPacked Allpass.phaserPacked (allpassControl TypeNum.d16 reduct) allpassPacked :: IO (ChunkSize -> ((Int,Int), Int) -> SimFloat) 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) -> SimStateFloat) 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.lowpassCausal $< SigP.constant (FirstOrderCore.parameter ^<< cutOff) $* xs firstOrderExponential :: IO (ChunkSize -> (Int,Int) -> SimFloat) 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.lowpassCausal $< 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) -> SimStateFloat) 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 VectorValue -> SigP.T p VectorValue firstOrderCausalPacked reduct = applyPacked FirstOrder.lowpassCausalPacked (lfoSine FirstOrder.parameter reduct) firstOrderPacked :: IO (ChunkSize -> ((Int,Int), Int) -> SimFloat) 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.causal $< lfoSine (SecondOrder.bandpassParameter (LLVM.valueOf (10::Float))) reduct $* xs secondOrderCausalPacked :: Param.T p Float -> SigP.T p VectorValue -> SigP.T p VectorValue secondOrderCausalPacked reduct = applyPacked SecondOrder.causalPacked (lfoSine (SecondOrder.bandpassParameter (LLVM.valueOf (10::Float))) reduct) secondOrderPacked :: IO (ChunkSize -> ((Int,Int), Int) -> SimFloat) 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.causal $< lfoSine (SecondOrderP.bandpassParameter (LLVM.valueOf (10::Float))) reduct $* xs secondOrderPacked2 :: IO (ChunkSize -> ((Int,Int), Int) -> SimFloat) secondOrderPacked2 = let freq = rangeFromInt (0.001, 0.01) <<^ fst . fst phase = rangeFromInt (0, 0.99 :: Float) <<^ 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.causal $< 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) -> SimStateFloat) 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.NaturalT n, TypeNum.IsNatural n ~ TypeBool.True) => n -> Param.T p Float -> SigP.T p (Value Float) -> SigP.T p (Value Float) moogCausal order reduct xs = Moog.causal $< 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) -> SimStateFloat) 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.fromIntegerT 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.causal $< lfoSine (ComplexFilter.parameter (LLVM.valueOf (10::Float))) reduct) <<^ (\x -> Stereo.cons x A.zero) complexCausalPacked :: Param.T p Float -> SigP.T p (Value Float) -> SigP.T p (Stereo.T (Value Float)) complexCausalPacked reduct = CausalP.apply $ (ComplexFilterP.causal $< lfoSine (ComplexFilterP.parameter (LLVM.valueOf (10::Float))) reduct) <<^ (\x -> Stereo.cons x A.zero) complexPacked :: IO (ChunkSize -> ((Int,Int), Int) -> SimFloat) complexPacked = let freq = rangeFromInt (0.001, 0.01) <<^ fst . fst phase = rangeFromInt (0, 0.99 :: Float) <<^ 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) -> SimStateFloat) 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)) -} convolvePacked :: IO (ChunkSize -> ((Int,Int), Word32) -> SimFloat) convolvePacked = let mask = (\(len, seed) -> fst $ SV.packN len $ Rnd.randomRs (-1,1::Float) seed) ^<< rangeFromInt (1,20) *** arr Rnd.mkStdGen <<^ fst noise = SigP.noise (arr snd) 1 noiseP = SigPS.noise (arr snd) 1 unpack :: SigP.T p VectorValue -> SigP.T p (Value Float) unpack = SigPS.unpack in checkSimilarity 1e-3 limitFloat (FiltNR.convolve mask $* noise) (unpack $ (FiltNR.convolvePacked mask $* noiseP)) 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) : ("convolvePacked", quickCheck =<< convolvePacked) : []