Helix.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Rank2Types #-}
module Test.Synthesizer.LLVM.Helix (tests) where

import qualified Synthesizer.LLVM.CausalParameterized.Helix as Helix
import qualified Synthesizer.LLVM.CausalParameterized.Functional as Func
import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
import qualified Synthesizer.LLVM.Parameter as Param
import qualified Synthesizer.LLVM.Interpolation as Interpolation
import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&))
import Synthesizer.LLVM.CausalParameterized.Process (($*))
import Synthesizer.LLVM.Parameter (($#))

import qualified Data.StorableVector.Lazy as SVL
import qualified Data.StorableVector as SV
import Data.StorableVector.Lazy (ChunkSize)

import Test.Synthesizer.LLVM.Generator (withPreparedArgs, checkWithParam)
import Test.Synthesizer.LLVM.Utility
          (CheckSimilarity, checkSimilarity,
           genRandomVectorParam, randomSignal)

import Control.Arrow (arr)
import Control.Applicative (pure, liftA2)

import LLVM.Core (Value)

import Foreign.Storable (Storable)

import qualified System.Random as Rnd
import Data.Word (Word32)

-- import qualified Graphics.Gnuplot.Simple as Gnuplot
import qualified Test.QuickCheck as QC

import NumericPrelude.Numeric
import NumericPrelude.Base


type SimFloat = CheckSimilarity Float

signalLength :: Int
signalLength = 500


limitFloat :: (Storable a) => SVL.Vector a -> SVL.Vector a
limitFloat = SVL.take signalLength


randomSpeed :: Param.T p (Int, Rnd.StdGen) -> SigP.T p (Value Float)
randomSpeed = randomSignal (0,10::Float)

randomPhase :: Param.T p (Int, Rnd.StdGen) -> SigP.T p (Value Float)
randomPhase = randomSignal (0,1::Float)

genStaticDynamic ::
   QC.Gen (((Int, Rnd.StdGen), (Int, Rnd.StdGen)), (Float, Word32))
genStaticDynamic =
   liftA2 (,)
      (liftA2 (,) genRandomVectorParam genRandomVectorParam)
      (liftA2 (,) (QC.choose (1,32)) QC.arbitrary)

staticDynamic ::
   IO (ChunkSize ->
       (((Int, Rnd.StdGen), (Int, Rnd.StdGen)), (Float, Word32)) -> SimFloat)
staticDynamic =
   withPreparedArgs
      (Func.pairArgs
         (Func.pairArgs Func.atomArg Func.atomArg)
         (Func.pairArgs Func.atomArg Func.atomArg)) $
      \((speedParam, phaseParam), (period, noiseParam)) ->
   let len = 1000
       noise :: Param.T p Word32 -> SigP.T p (Value Float)
       noise seed = CausalP.take (pure len) $* SigP.noise seed 1

       static =
          Helix.static Interpolation.linear Interpolation.linear
             (fmap round period) period
             (fmap (\seed -> SigP.render (noise (arr id)) len seed :: SV.Vector Float) noiseParam)
          $&
          Func.fromSignal
             ((CausalP.integrate $# (0::Float)) $* randomSpeed speedParam)
          &|&
          Func.fromSignal (randomPhase phaseParam)

       dynamic =
          Helix.dynamic Interpolation.linear Interpolation.linear
             (fmap round period) period (noise noiseParam)
          $&
          Func.fromSignal (randomSpeed speedParam)
          &|&
          Func.fromSignal (randomPhase phaseParam)

   in  checkSimilarity 5e-3 limitFloat
          (Func.compileSignal static)
          (Func.compileSignal dynamic)

{-
plot :: IO ()
plot = do
   render <- staticDynamic
   case render (SVL.chunkSize 1)
            (((76, Rnd.mkStdGen 0),(84, Rnd.mkStdGen 23)),(8.901705,11)) of
      CheckSimilarity _tol xs ys ->
         Gnuplot.plotLists [] [SVL.unpack xs, SVL.unpack ys]
         >>
         Gnuplot.plotList [] (zipWith (-) (SVL.unpack xs) (SVL.unpack ys))
-}


tests :: [(String, IO ())]
tests =
   ("staticDynamic", checkWithParam (genStaticDynamic, staticDynamic)) :
   []