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

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

import qualified Test.Synthesizer.LLVM.Generator as Gen
import Test.Synthesizer.LLVM.Generator
   (Test, checkWithParam, arg, pair, withGenArgs, )
import Test.Synthesizer.LLVM.Utility
   (checkSimilarity, checkEquality,
    CheckSimilarity, CheckEquality, checkSimilarityPacked, )

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

import Type.Data.Num.Decimal (D4, )
import qualified Type.Data.Num.Decimal 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.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 (arr, (<<<), )
import Control.Applicative ((<$>), )

import Data.Word (Word32, )

import qualified Test.QuickCheck as QC
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


withDur ::
   (Param.T Float Float -> IO (ChunkSize -> Float -> test)) ->
   Test Float test
withDur =
   withGenArgs (arg (fromIntegral <$> QC.choose (signalLength, 2*signalLength)))

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

constant :: Test Float SimFloat
constant =
   withGenArgs (Gen.choose (-1, 1)) $ \y ->
      checkSimilarityPacked 1e-3 limitFloat
         (SigP.constant y) (SigPS.constant y)

ramp :: Test Float SimFloat
ramp =
   withDur $ \dur ->
      checkSimilarityPacked 1e-3 limitFloat
         (SigP.rampInf dur) (SigPS.rampInf dur)

parabolaFadeIn :: Test Float SimFloat
parabolaFadeIn =
   withDur $ \dur ->
      checkSimilarityPacked 1e-3 limitFloat
         (SigP.parabolaFadeInInf dur)
         (SigPS.parabolaFadeInInf dur)

parabolaFadeOut :: Test Float SimFloat
parabolaFadeOut =
   withDur $ \dur ->
      checkSimilarityPacked 1e-3 limitFloat
         (SigP.parabolaFadeOutInf dur)
         (SigPS.parabolaFadeOutInf dur)

parabolaFadeInMap :: Test Float SimFloat
parabolaFadeInMap =
   withDur $ \dur ->
      checkSimilarity 1e-3 limitFloat
          (SigP.parabolaFadeIn dur)
          (SigP.parabolaFadeInMap dur)

parabolaFadeOutMap :: Test Float SimFloat
parabolaFadeOutMap =
   withDur $ \dur ->
      checkSimilarity 1e-3 limitFloat
          (SigP.parabolaFadeOut dur)
          (SigP.parabolaFadeOutMap dur)


genExp :: Gen.T (Param.T p) (Float, Float) (Param.T p Float, Param.T p Float)
genExp = pair (Gen.choose (1000,10000)) (Gen.choose (-1,1))

exponential2 :: Test (Float,Float) SimFloat
exponential2 =
   withGenArgs genExp $ \(halfLife,start) ->
      checkSimilarityPacked 1e-3 limitFloat
         (SigP.exponential2 halfLife start)
         (SigPS.exponential2 halfLife start)

exponential2Static :: Test (Float,Float) SimFloat
exponential2Static =
   withGenArgs genExp $ \(halfLife,start) ->
      checkSimilarity 1e-3 limitFloat
          (SigP.exponential2 halfLife start)
          (Exp.causalP start <<<
           CausalP.mapSimple Exp.parameter $*
           SigP.constant halfLife)

exponential2PackedStatic :: Test (Float,Float) SimFloat
exponential2PackedStatic =
   withGenArgs genExp $ \(halfLife,start) ->
      checkSimilarity 1e-3 (limitFloat . SigStL.unpack)
          (SigPS.exponential2 halfLife start ::
           SigP.T (Float,Float) VectorValue)
          (Exp.causalPackedP start <<<
           CausalP.mapSimple Exp.parameterPacked $*
           SigP.constant halfLife)

exponential2Controlled :: Test ((Float,Float), (Float,Float)) SimFloat
exponential2Controlled =
   withGenArgs
      (pair genExp
         (pair (Gen.choose (0.0001, 0.001)) (Gen.choose (0, 0.99 :: Float)))) $

   -- 'freq' is the LFO frequency measured at vector-rate
   \((halfLife,start), (freq,phase)) ->
   let lfo =
          CausalP.mapExponential 2 halfLife $*
          SigP.osciSimple Wave.approxSine2 phase freq
   in  checkSimilarityPacked 1e-3 limitFloat
          (Exp.causalP start <<<
           CausalP.mapSimple Exp.parameter $*
           SigP.interpolateConstant
              (TypeNum.integralFromProxy TypeNum.d4 :: Param.T p Float)
              lfo)
          (Exp.causalPackedP start <<<
           CausalP.mapSimple Exp.parameterPacked $* lfo)

osci :: Test (Float,Float) SimFloat
osci =
   withGenArgs
      (pair
         (Gen.choose (0.001, 0.01))
         (Gen.choose (0, 0.99))) $
   \(freq,phase) ->
      checkSimilarityPacked 1e-2 limitFloat
         (SigP.osciSimple Wave.approxSine2 phase freq)
         (SigPS.osciSimple Wave.approxSine2 phase freq)



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 -> Word32 -> CheckEquality Word32)
noise =
   checkEquality limitWord32
      (SigP.noiseCore (arr id))
      (SigP.noiseCoreAlt (arr id))

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

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


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