synthesizer-llvm-0.5: testsuite/Test/Synthesizer/LLVM/Packed.hs

{-# LANGUAGE NoImplicitPrelude #-}
module Test.Synthesizer.LLVM.Packed (tests) where

import Test.Synthesizer.LLVM.Utility
   (checkSimilarity, checkEquality, rangeFromInt,
    CheckSimilarity, CheckEquality, )

import qualified Synthesizer.LLVM.Wave as Wave
import qualified Synthesizer.LLVM.Parameter as Param

import Types.Data.Num (D4, )
import qualified Types.Data.Num as TypeNum

import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
import qualified Synthesizer.LLVM.Generator.Exponential2 as Exp
import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS
import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
import Synthesizer.LLVM.Parameterized.Signal (($#), )
import Synthesizer.LLVM.CausalParameterized.Process (($*), )

import qualified Synthesizer.LLVM.Storable.Signal as SigStL
import qualified Data.StorableVector.Lazy as SVL
import Data.StorableVector.Lazy (ChunkSize, )

import Control.Arrow ((^<<), (<<^), (<<<), )

import Data.Word (Word32, )

import Test.QuickCheck (quickCheck, )

import NumericPrelude.Numeric
import NumericPrelude.Base


type SimFloat = CheckSimilarity Float
type VectorValue = Serial.Value D4 Float

signalLength :: Int
signalLength = 10000


limitFloat :: SVL.Vector Float -> SVL.Vector Float
limitFloat = SVL.take signalLength


durFromInt :: Param.T Int Float
durFromInt =
   fromIntegral ^<< rangeFromInt (signalLength,2*signalLength)

{-
limitPackedFloat ::
   SVL.Vector (Serial.Plain D4 Float) -> SVL.Vector (Serial.Plain D4 Float)
limitPackedFloat = SVL.take (div signalLength 4)
-}

constant :: IO (ChunkSize -> Int -> SimFloat)
constant =
   let y = rangeFromInt (-1, 1)
   in  checkSimilarity 1e-3 limitFloat
          (SigP.constant y)
          (SigPS.unpack (SigPS.constant y :: SigP.T Int VectorValue))

ramp :: IO (ChunkSize -> Int -> SimFloat)
ramp =
   let dur = durFromInt
   in  checkSimilarity 1e-3 limitFloat
          (SigP.rampInf dur)
          (SigPS.unpack (SigPS.rampInf dur :: SigP.T Int VectorValue))

parabolaFadeIn :: IO (ChunkSize -> Int -> SimFloat)
parabolaFadeIn =
   let dur = durFromInt
   in  checkSimilarity 1e-3 limitFloat
          (SigP.parabolaFadeInInf dur)
          (SigPS.unpack (SigPS.parabolaFadeInInf dur ::
                         SigP.T Int VectorValue))

parabolaFadeOut :: IO (ChunkSize -> Int -> SimFloat)
parabolaFadeOut =
   let dur = durFromInt
   in  checkSimilarity 1e-3 limitFloat
          (SigP.parabolaFadeOutInf dur)
          (SigPS.unpack (SigPS.parabolaFadeOutInf dur ::
                         SigP.T Int VectorValue))

parabolaFadeInMap :: IO (ChunkSize -> Int -> SimFloat)
parabolaFadeInMap =
   let dur = durFromInt
   in  checkSimilarity 1e-3 limitFloat
          (SigP.parabolaFadeIn dur)
          (SigP.parabolaFadeInMap dur)

parabolaFadeOutMap :: IO (ChunkSize -> Int -> SimFloat)
parabolaFadeOutMap =
   let dur = durFromInt
   in  checkSimilarity 1e-3 limitFloat
          (SigP.parabolaFadeOut dur)
          (SigP.parabolaFadeOutMap dur)

exponential2 :: IO (ChunkSize -> (Int,Int) -> SimFloat)
exponential2 =
   let halfLife = rangeFromInt (1000,10000) <<^ fst
       start    = rangeFromInt (  -1,    1) <<^ snd
   in  checkSimilarity 1e-3 limitFloat
          (SigP.exponential2 halfLife start)
          (SigPS.unpack (SigPS.exponential2 halfLife start ::
                         SigP.T (Int,Int) VectorValue))

exponential2Static :: IO (ChunkSize -> (Int,Int) -> SimFloat)
exponential2Static =
   let halfLife = rangeFromInt (1000,10000) <<^ fst
       start    = rangeFromInt (  -1,    1) <<^ snd
   in  checkSimilarity 1e-3 limitFloat
          (SigP.exponential2 halfLife start)
          (Exp.causalP start <<<
           CausalP.mapSimple Exp.parameter $*
           SigP.constant halfLife)

exponential2PackedStatic :: IO (ChunkSize -> (Int,Int) -> SimFloat)
exponential2PackedStatic =
   let halfLife = rangeFromInt (1000,10000) <<^ fst
       start    = rangeFromInt (  -1,    1) <<^ snd
   in  checkSimilarity 1e-3 (limitFloat . SigStL.unpack)
          (SigPS.exponential2 halfLife start ::
           SigP.T (Int,Int) VectorValue)
          (Exp.causalPackedP start <<<
           CausalP.mapSimple Exp.parameterPacked $*
           SigP.constant halfLife)

exponential2Controlled :: IO (ChunkSize -> ((Int,Int), (Int,Int)) -> SimFloat)
exponential2Controlled =
   let halfLife = rangeFromInt (1000,10000) <<^ (fst.fst)
       start    = rangeFromInt (  -1,    1) <<^ (snd.fst)
       -- this is the LFO frequency measured at vector-rate
       freq  = rangeFromInt (0.0001, 0.001) <<^ (fst.snd)
       phase = rangeFromInt (0, 0.99 :: Float) <<^ (snd.snd)
       lfo =
          CausalP.mapExponential 2 halfLife $*
          SigP.osciSimple Wave.approxSine2 phase freq
   in  checkSimilarity 1e-3 limitFloat
          (Exp.causalP start <<<
           CausalP.mapSimple Exp.parameter $*
           SigP.interpolateConstant
              (TypeNum.fromIntegerT TypeNum.d4 :: Param.T p Float)
              lfo)
          (SigPS.unpack
             (Exp.causalPackedP start <<<
              CausalP.mapSimple Exp.parameterPacked $*
              lfo :: SigP.T ((Int,Int),(Int,Int)) VectorValue))

osci :: IO (ChunkSize -> (Int,Int) -> SimFloat)
osci =
   let freq  = rangeFromInt (0.001, 0.01) <<^ fst
       phase = rangeFromInt (0, 0.99)     <<^ snd
   in  checkSimilarity 1e-2 limitFloat
          (SigP.osciSimple Wave.approxSine2 phase freq)
          (SigPS.unpack (SigPS.osciSimple Wave.approxSine2 phase freq ::
                         SigP.T (Int,Int) VectorValue))



limitWord32 :: SVL.Vector Word32 -> SVL.Vector Word32
limitWord32 = SVL.take signalLength

limitPackedWord32 ::
   SVL.Vector (Serial.Plain D4 Word32) -> SVL.Vector (Serial.Plain D4 Word32)
limitPackedWord32 = SVL.take (div signalLength 4)


noise :: IO (ChunkSize -> () -> CheckEquality Word32)
noise =
   checkEquality limitWord32
      (SigP.noiseCore $# 0)
      (SigP.noiseCoreAlt $# 0)

noiseVector :: IO (ChunkSize -> () -> CheckEquality (Serial.Plain D4 Word32))
noiseVector =
   checkEquality limitPackedWord32
      (SigPS.noiseCore $# 0)
      (SigPS.noiseCoreAlt $# 0)

noiseScalarVector :: IO (ChunkSize -> () -> CheckEquality (Serial.Plain D4 Word32))
noiseScalarVector =
   checkEquality limitPackedWord32
      (SigPS.noiseCore $# 0)
      (SigPS.packSmall (SigP.noiseCore $# 0))


tests :: [(String, IO ())]
tests =
   ("constant", quickCheck =<< constant) :
   ("ramp", quickCheck =<< ramp) :
   ("parabolaFadeIn", quickCheck =<< parabolaFadeIn) :
   ("parabolaFadeOut", quickCheck =<< parabolaFadeOut) :
   ("parabolaFadeInMap", quickCheck =<< parabolaFadeInMap) :
   ("parabolaFadeOutMap", quickCheck =<< parabolaFadeOutMap) :
   ("exponential2", quickCheck =<< exponential2) :
   ("exponential2Static", quickCheck =<< exponential2Static) :
   ("exponential2PackedStatic", quickCheck =<< exponential2PackedStatic) :
   ("exponential2Controlled", quickCheck =<< exponential2Controlled) :
   ("osci", quickCheck =<< osci) :
   ("noise", quickCheck =<< noise) :
   ("noiseVector", quickCheck =<< noiseVector) :
   ("noiseScalarVector", quickCheck =<< noiseScalarVector) :
   []