synthesizer-llvm-0.3: src/Test/Synthesizer/LLVM/Packed.hs

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

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

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

import LLVM.Core (Value, Vector, )
import Data.TypeLevel.Num (D4, )
import qualified Data.TypeLevel.Num as TypeNum

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


signalLength :: Int
signalLength = 10000


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

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

constant :: IO (ChunkSize -> Int -> Bool)
constant =
   let y = rangeFromInt (-1, 1)
   in  checkSimilarity 1e-3 limitFloat
          (SigP.constant y)
          (SigPS.unpack (SigPS.constant y ::
                         SigP.T Int (Value (Vector D4 Float))))

ramp :: IO (ChunkSize -> Int -> Bool)
ramp =
   let dur = fromIntegral ^<< rangeFromInt (signalLength,2*signalLength)
   in  checkSimilarity 1e-3 limitFloat
          (SigP.rampInf dur)
          (SigPS.unpack (SigPS.rampInf dur ::
                         SigP.T Int (Value (Vector D4 Float))))

parabolaFadeIn :: IO (ChunkSize -> Int -> Bool)
parabolaFadeIn =
   let dur = fromIntegral ^<< rangeFromInt (signalLength,2*signalLength)
   in  checkSimilarity 1e-3 limitFloat
          (SigP.parabolaFadeInInf dur)
          (SigPS.unpack (SigPS.parabolaFadeInInf dur ::
                         SigP.T Int (Value (Vector D4 Float))))

parabolaFadeOut :: IO (ChunkSize -> Int -> Bool)
parabolaFadeOut =
   let dur = fromIntegral ^<< rangeFromInt (signalLength,2*signalLength)
   in  checkSimilarity 1e-3 limitFloat
          (SigP.parabolaFadeOutInf dur)
          (SigPS.unpack (SigPS.parabolaFadeOutInf dur ::
                         SigP.T Int (Value (Vector D4 Float))))

parabolaFadeInMap :: IO (ChunkSize -> Int -> Bool)
parabolaFadeInMap =
   let dur = fromIntegral ^<< rangeFromInt (signalLength,2*signalLength)
   in  checkSimilarity 1e-3 limitFloat
          (SigP.parabolaFadeIn dur)
          (SigP.parabolaFadeInMap dur)

parabolaFadeOutMap :: IO (ChunkSize -> Int -> Bool)
parabolaFadeOutMap =
   let dur = fromIntegral ^<< rangeFromInt (signalLength,2*signalLength)
   in  checkSimilarity 1e-3 limitFloat
          (SigP.parabolaFadeOut dur)
          (SigP.parabolaFadeOutMap dur)

exponential2 :: IO (ChunkSize -> (Int,Int) -> Bool)
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) (Value (Vector D4 Float))))

exponential2Static :: IO (ChunkSize -> (Int,Int) -> Bool)
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) -> Bool)
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) (Value (Vector D4 Float)))
          (Exp.causalPackedP start <<<
           CausalP.mapSimple Exp.parameterPacked $*
           SigP.constant halfLife)

exponential2Controlled :: IO (ChunkSize -> ((Int,Int), (Int,Int)) -> Bool)
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)       <<^ (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
              (fromIntegral (TypeNum.toInt TypeNum.d4) :: Param.T p Float)
              lfo)
          (SigPS.unpack
             (Exp.causalPackedP start <<<
              CausalP.mapSimple Exp.parameterPacked $*
              lfo ::
                 SigP.T ((Int,Int),(Int,Int)) (Value (Vector D4 Float))))

osci :: IO (ChunkSize -> (Int,Int) -> Bool)
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) (Value (Vector D4 Float))))



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

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


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

noiseVector :: IO (ChunkSize -> () -> Bool)
noiseVector =
   checkEquality limitPackedWord32
      (SigPS.noiseCore $# 0)
      (SigPS.noiseCoreAlt $# 0)

noiseScalarVector :: IO (ChunkSize -> () -> Bool)
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) :
   []