ToneModulation.hs

module Test.Sound.Synthesizer.Generic.ToneModulation (tests) where

import Test.Sound.Synthesizer.Basic.ToneModulation (
   minLength,
   minLengthMargin,
--   shapeLimits,
--   testRationalLineIp,
   testRationalIp,
   )

import Test.Sound.Synthesizer.Plain.ToneModulation (
   InfiniteList,
   listFromInfinite,
   )

import qualified Synthesizer.Causal.ToneModulation as ToneModC
import qualified Synthesizer.Generic.Wave as WaveG

import qualified Synthesizer.Plain.Signal         as Sig
import qualified Synthesizer.Plain.Oscillator     as Osci
import qualified Synthesizer.Plain.Interpolation  as Interpolation
import qualified Synthesizer.Plain.ToneModulation as ToneModL
import qualified Synthesizer.Plain.Wave   as WaveL
import Synthesizer.Interpolation (marginNumber, )

import qualified Synthesizer.Causal.Oscillator as OsciC
import qualified Synthesizer.Causal.Process as Causal

import qualified Synthesizer.State.Signal as SigS

import qualified Synthesizer.Basic.Wave           as Wave
import qualified Synthesizer.Basic.Phase          as Phase

import qualified Test.Sound.Synthesizer.Plain.Interpolation as InterpolationTest

import Test.QuickCheck (test, Property, (==>), )
import Test.Utility (ArbChar, )
-- import Debug.Trace (trace, )

import qualified Number.NonNegative       as NonNeg

-- import qualified Algebra.RealTranscendental    as RealTrans
-- import qualified Algebra.Module                as Module
import qualified Algebra.RealField             as RealField
-- import qualified Algebra.Field                 as Field
-- import qualified Algebra.Ring                  as Ring
import qualified Algebra.Additive              as Additive


import Data.List.HT (viewL, takeWhileJust, )
import Data.Tuple.HT (mapSnd, )
import qualified Data.List as List


import NumericPrelude
import PreludeBase
import Prelude ()


limitMinRelativeValues ::
   Int -> Int -> [NonNeg.Int] -> Bool
limitMinRelativeValues xMin x0 xsnn =
   let xs = map NonNeg.toNumber xsnn
       (y0,limiter) = ToneModC.limitMinRelativeValues xMin x0
   in  (y0, Causal.applyGeneric limiter xs) ==
          ToneModL.limitMinRelativeValues xMin x0 xs

integrateFractional :: (RealField.C t) =>
   NonNeg.T t -> t -> Phase.T t -> [NonNeg.T t] -> [t] -> Property
integrateFractional
     periodNN shape0 phase shapesNN freqs =
   let shapes = map NonNeg.toNumber shapesNN
       period    = NonNeg.toNumber periodNN
       (c0, coordinator) =
          ToneModC.integrateFractional
             period (shape0, phase)
       coords =
          ToneModL.integrateFractional
             period (shape0, shapes) (phase, freqs)
   in  period /= zero  ==>
          c0 : Causal.applyGeneric coordinator (zip shapes freqs) ==
          coords

-- oscillatorCellSize :: (Show t, Show v, RealField.C t, Eq v) =>
oscillatorCellSize :: (RealField.C t, Eq v) =>
   Interpolation.Margin ->
   Interpolation.Margin ->
   NonNeg.Int -> NonNeg.T t ->
   NonNeg.Int -> InfiniteList v ->
   t -> t -> [NonNeg.T t] -> [t] ->
   Property
oscillatorCellSize
      marginLeap marginStep periodIntNN periodNN ext
      ixs shape0 phase shapesNN freqs =
   let shapes = map NonNeg.toNumber shapesNN
       period    = NonNeg.toNumber periodNN
       periodInt = NonNeg.toNumber periodIntNN
       len = minLengthMargin marginLeap marginStep periodInt ext
       tone = take len (listFromInfinite ixs)
       resampledTone =
          ToneModC.oscillatorCells
             marginLeap marginStep periodInt period tone
             (shape0, Phase.fromRepresentative phase)
          `Causal.applyGeneric`
          zip shapes freqs
   in  period /= zero  &&
       marginNumber marginLeap > zero &&
       marginNumber marginStep > zero  ==>
       all
          ((\cell ->
              Sig.lengthAtLeast (marginNumber marginLeap) cell &&
              all (Sig.lengthAtLeast (marginNumber marginStep))
                  (take (marginNumber marginLeap) cell))
           . SigS.toList . snd)
          resampledTone

oscillatorSuffixes :: (RealField.C t, Eq v) =>
   Interpolation.Margin ->
   Interpolation.Margin ->
   NonNeg.Int -> NonNeg.T t ->
   NonNeg.Int -> InfiniteList v ->
   t -> t -> [NonNeg.T t] -> [t] ->
   Property
oscillatorSuffixes
      marginLeap marginStep periodIntNN periodNN ext
      ixs shape0 phase shapesNN freqs =
   let shapes = map NonNeg.toNumber shapesNN
       period    = NonNeg.toNumber periodNN
       periodInt = NonNeg.toNumber periodIntNN
       len = minLengthMargin marginLeap marginStep periodInt ext
       tone = take len (listFromInfinite ixs)
       resampledToneA =
          init $
          map (\(sp,cell) ->
             (sp, takeWhileJust . map (fmap fst . viewL) $ cell)) $
          ToneModL.oscillatorSuffixes
             marginLeap marginStep periodInt period tone
             (shape0, shapes) (Phase.fromRepresentative phase, freqs)
       resampledToneB =
          ToneModC.oscillatorSuffixes
             marginLeap marginStep periodInt period tone
             (shape0, Phase.fromRepresentative phase)
          `Causal.applyGeneric`
          zip shapes freqs
   in  period /= zero  &&
       periodInt /= zero  &&
       marginNumber marginLeap > zero &&
       marginNumber marginStep > zero  ==>
          resampledToneA == resampledToneB

oscillatorCells :: (RealField.C t, Eq v) =>
   Interpolation.Margin ->
   Interpolation.Margin ->
   NonNeg.Int -> NonNeg.T t ->
   NonNeg.Int -> InfiniteList v ->
   t -> t -> [NonNeg.T t] -> [t] ->
   Property
oscillatorCells
      marginLeap marginStep periodIntNN periodNN ext
      ixs shape0 phase shapesNN freqs =
   let shapes = map NonNeg.toNumber shapesNN
       period    = NonNeg.toNumber periodNN
       periodInt = NonNeg.toNumber periodIntNN
       len = minLengthMargin marginLeap marginStep periodInt ext
       tone = take len (listFromInfinite ixs)
       resampledToneA =
          init $ map (mapSnd List.transpose) $
          ToneModL.oscillatorCells
             marginLeap marginStep periodInt period tone
             (shape0, shapes) (Phase.fromRepresentative phase, freqs)
       resampledToneB =
          map (mapSnd SigS.toList) $
          ToneModC.oscillatorCells
             marginLeap marginStep periodInt period tone
             (shape0, Phase.fromRepresentative phase)
          `Causal.applyGeneric`
          zip shapes freqs
   in  period /= zero  &&
       periodInt /= zero  &&
       marginNumber marginLeap > zero &&
       marginNumber marginStep > zero  ==>
          resampledToneA == resampledToneB
{-
Margin {marginNumber = 1, marginOffset = 2}
Margin {marginNumber = 5, marginOffset = 5}
3 % 4
0
('\DEL',['~','~','"'])
-2 % 5
2 % 5
[2 % 1,3 % 4]
[-5 % 2,-1 % 2]
-}

{- |
'WaveL.sampledTone' and 'WaveG.sampledTone'
do not only differ in the signal types they process,
but also in the way they order the signal values.
The cells for 'WaveL.sampledTone' are transposed
with respect to 'WaveG.sampledTone'.
-}
sampledTone :: (RealField.C a, Eq v) =>
   InterpolationTest.T a v ->
   InterpolationTest.T a v ->
   NonNeg.T a -> NonNeg.Int -> InfiniteList v ->
   a -> Phase.T a -> Property
sampledTone =
   InterpolationTest.use2 $ \ ipLeap ipStep
         periodNN ext ixs shape phase ->
   let period = NonNeg.toNumber periodNN
       periodInt = round period
       len = minLength ipLeap ipStep periodInt ext
       tone = take len (listFromInfinite ixs)
   in  period /= zero ==>
          WaveG.sampledTone ipLeap ipStep period tone shape `Wave.apply` phase ==
          WaveL.sampledTone ipLeap ipStep period tone shape `Wave.apply` phase



shapeFreqModFromSampledTone :: (RealField.C t, Eq v) =>
   InterpolationTest.T t v ->
   InterpolationTest.T t v ->
   NonNeg.T t ->
   NonNeg.Int -> InfiniteList v ->
   t -> Phase.T t -> [NonNeg.T t] -> [t] ->
   Property
shapeFreqModFromSampledTone =
   InterpolationTest.use2 $ \ ipLeap ipStep
         periodNN ext ixs shape0 phase shapesNN freqs ->
   let shapes = map NonNeg.toNumber shapesNN
       period = NonNeg.toNumber periodNN
       periodInt = round period
       len = minLength ipLeap ipStep periodInt ext
       tone = take len (listFromInfinite ixs)
       resampledToneA =
          init $
          Osci.shapeFreqModFromSampledTone ipLeap ipStep period tone
             shape0 (Phase.toRepresentative phase) shapes freqs
       resampledToneB =
          OsciC.shapeFreqModFromSampledTone
             ipLeap ipStep period tone shape0 phase
          `Causal.applyGeneric`
          zip shapes freqs
   in  period /= zero  ==>
          resampledToneA == resampledToneB


{-
We have a problem here with the phase distortion signal,
because frequency and shape modulation control signals
are delayed by one element with respect to the phase distortion.
How can we cope with different lengths of the control signals,
without padding the phase control with zeros?
This one did not work:
   phaseDistorts = pd:pds
   resampledToneA =
      Osci.shapePhaseFreqModFromSampledTone ipLeap ipStep period tone
         shape0 (Phase.toRepresentative phase) shapes (init phaseDistorts) freqs
-}
shapePhaseFreqModFromSampledTone :: (RealField.C t, Eq v) =>
   InterpolationTest.T t v ->
   InterpolationTest.T t v ->
   NonNeg.T t ->
   NonNeg.Int -> InfiniteList v ->
   t -> Phase.T t -> [NonNeg.T t] -> (t,[t]) -> [t] ->
   Property
shapePhaseFreqModFromSampledTone =
   InterpolationTest.use2 $ \ ipLeap ipStep
         periodNN ext ixs shape0 phase shapesNN (pd,pds) freqs ->
   let period = NonNeg.toNumber periodNN
       periodInt = round period
       len = minLength ipLeap ipStep periodInt ext
       tone = take len (listFromInfinite ixs)
       shapes = map NonNeg.toNumber shapesNN
       phaseDistorts = pd:pds ++ repeat zero
       resampledToneA =
          init $
          Osci.shapePhaseFreqModFromSampledTone ipLeap ipStep period tone
             shape0 (Phase.toRepresentative phase) shapes phaseDistorts freqs
       resampledToneB =
          OsciC.shapePhaseFreqModFromSampledTone
             ipLeap ipStep period tone shape0 phase
          `Causal.applyGeneric`
          zip3 shapes phaseDistorts freqs
   in  period /= zero  ==>
          resampledToneA == resampledToneB



tests :: [(String, IO ())]
tests =
   ("limitMinRelativeValues", test limitMinRelativeValues) :
   ("integrateFractional",
      test (\period -> integrateFractional (period :: NonNeg.Rational))) :
   ("oscillatorCellSize",
      test (\ml ms periodInt period ext ixs ->
               oscillatorCellSize ml ms periodInt (period :: NonNeg.Rational)
                  ext (ixs :: InfiniteList ArbChar))) :
   ("oscillatorSuffixes",
      test (\ml ms periodInt period ext ixs ->
               oscillatorSuffixes ml ms periodInt (period :: NonNeg.Rational)
                  ext (ixs :: InfiniteList ArbChar))) :
   ("oscillatorCells",
      test (\ml ms periodInt period ext ixs ->
               oscillatorCells ml ms periodInt (period :: NonNeg.Rational)
                  ext (ixs :: InfiniteList ArbChar))) :
   ("sampledTone",
      testRationalIp sampledTone) :
   ("shapeFreqModFromSampledTone",
      testRationalIp shapeFreqModFromSampledTone) :
   ("shapePhaseFreqModFromSampledTone",
      testRationalIp shapePhaseFreqModFromSampledTone) :
   []