synthesizer-0.0.3: src/Test/Sound/Synthesizer/Plain/ToneModulation.hs
module Test.Sound.Synthesizer.Plain.ToneModulation (tests) where
import qualified Synthesizer.Plain.Oscillator as Osci
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Basic.Phase as Phase
import qualified Synthesizer.Plain.Interpolation as Interpolation
import qualified Synthesizer.Plain.ToneModulation as ToneMod
import qualified Test.Sound.Synthesizer.Plain.Interpolation as InterpolationTest
import Test.QuickCheck (test, Property, (==>), Testable, )
-- import Test.Utility
import qualified Number.NonNegative as NonNeg
import qualified Number.NonNegativeChunky as Chunky
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 Synthesizer.Utility (clip, mapPair, )
import qualified Data.List as List
import NumericPrelude
import PreludeBase
import Prelude ()
untangleShapePhase :: (Field.C a, Eq a) =>
Int -> a -> (a, a) -> Property
untangleShapePhase periodInt period c =
period /= zero ==>
ToneMod.untangleShapePhase periodInt period c ==
ToneMod.untangleShapePhaseAnalytic periodInt period c
absolutize :: (Additive.C a) => a -> [a] -> [a]
absolutize = scanl (+)
limitMinRelativeValues ::
Int -> Int -> [NonNeg.Int] -> Bool
limitMinRelativeValues xMin x0 xsnn =
let xs = map NonNeg.toNumber xsnn
in map (max xMin) (absolutize x0 xs) ==
uncurry absolutize (ToneMod.limitMinRelativeValues xMin x0 xs)
limitMaxRelativeValues ::
Int -> Int -> [NonNeg.Int] -> Bool
limitMaxRelativeValues xMax x0 xsnn =
let xs = map NonNeg.toNumber xsnn
in map (min xMax) (absolutize x0 xs) ==
uncurry absolutize (ToneMod.limitMaxRelativeValues xMax x0 xs)
limitMaxRelativeValuesNonNeg ::
Int -> Int -> [NonNeg.Int] -> Bool
limitMaxRelativeValuesNonNeg xMax x0 xsnn =
let xs = map NonNeg.toNumber xsnn
in map (min xMax) (absolutize x0 xs) ==
uncurry absolutize (ToneMod.limitMaxRelativeValuesNonNeg xMax x0 xs)
-- chunky type is not necessary here but testing it a little is not wrong
limitMinRelativeValuesIdentity ::
Chunky.T NonNeg.Int -> [Chunky.T NonNeg.Int] -> Bool
limitMinRelativeValuesIdentity x0 xs =
(x0,xs) == ToneMod.limitMinRelativeValues 0 x0 xs
limitMaxRelativeValuesIdentity ::
Chunky.T NonNeg.Int -> [Chunky.T NonNeg.Int] -> Bool
limitMaxRelativeValuesIdentity x0 xs =
let inf = 1 + inf
in (x0,xs) == ToneMod.limitMaxRelativeValues inf x0 xs
limitMaxRelativeValuesNonNegIdentity ::
Chunky.T NonNeg.Int -> [Chunky.T NonNeg.Int] -> Bool
limitMaxRelativeValuesNonNegIdentity x0 xs =
let inf = 1 + inf
in (x0,xs) == ToneMod.limitMaxRelativeValuesNonNeg inf x0 xs
limitMaxRelativeValuesInfinity ::
Chunky.T NonNeg.Int -> (Chunky.T NonNeg.Int, [Chunky.T NonNeg.Int]) -> Bool
limitMaxRelativeValuesInfinity x0 (x,xs) =
let inf = 1 + inf
ys = cycle (x:xs)
(z0,zs) = ToneMod.limitMaxRelativeValues inf x0 ys
in (x0, take 100 ys) == (z0, take 100 zs)
limitMaxRelativeValuesNonNegInfinity ::
Chunky.T NonNeg.Int -> (Chunky.T NonNeg.Int, [Chunky.T NonNeg.Int]) -> Bool
limitMaxRelativeValuesNonNegInfinity x0 (x,xs) =
let inf = 1 + inf
ys = cycle (x:xs)
(z0,zs) = ToneMod.limitMaxRelativeValuesNonNeg inf x0 ys
in (x0, take 100 ys) == (z0, take 100 zs)
dropRem :: Eq a => Int -> [a] -> Bool
dropRem n xs =
let n1 = abs n
in map (flip ToneMod.dropRem xs) [0 .. n1 + length xs] ==
map ((,) 0) (List.tails xs) ++ map (flip (,) []) [1..n1]
withInterpolation ::
(Interpolation.T a v -> x) ->
(InterpolationTest.T a v -> x)
withInterpolation f ipt =
f (InterpolationTest.ip ipt)
withLPInterpolation ::
(Interpolation.T a v -> x) ->
(InterpolationTest.LinePreserving a v -> x)
withLPInterpolation f ipt =
f (InterpolationTest.lpIp ipt)
withInterpolation2 ::
(Interpolation.T a v ->
Interpolation.T a v -> x) ->
(InterpolationTest.T a v ->
InterpolationTest.T a v -> x)
withInterpolation2 f =
withInterpolation $ \ ipLeap ->
withInterpolation $ \ ipStep ->
f ipLeap ipStep
minLength ::
Interpolation.T a v ->
Interpolation.T a v ->
Int -> NonNeg.Int -> Int
minLength ipLeap ipStep periodInt ext =
Interpolation.number ipStep +
Interpolation.number ipLeap * periodInt +
NonNeg.toNumber ext
sampledTone :: (RealField.C a, Eq v) =>
InterpolationTest.T a v ->
InterpolationTest.T a v ->
NonNeg.T a -> NonNeg.Int -> (v,[v]) -> a -> Phase.T a -> Property
sampledTone =
withInterpolation2 $ \ ipLeap ipStep
periodNN ext (x,xs) shape phase ->
let period = NonNeg.toNumber periodNN
len = minLength ipLeap ipStep (ceiling period) ext
tone = take len (List.cycle (x:xs))
in period /= zero ==>
Wave.sampledToneAlt ipLeap ipStep period tone shape `Wave.apply` phase ==
Wave.sampledTone ipLeap ipStep period tone shape `Wave.apply` phase
sampledToneSine :: (RealTrans.C a, Module.C a a) =>
NonNeg.T a -> NonNeg.Int -> a -> a -> a -> Bool
sampledToneSine periodNN ext phase0 shape phase =
let ipLeap = Interpolation.cubic
ipStep = Interpolation.cubic
ten = fromInteger 10
period = ten + NonNeg.toNumber periodNN
len = minLength ipLeap ipStep (ceiling period) ext
tone = take len (Osci.staticSine phase0 (recip period))
in abs (Wave.sampledTone ipLeap ipStep period tone shape `Wave.apply` (Phase.fromRepresentative phase) -
head (Osci.staticSine (phase0+phase) zero)) < ten ^- (-2)
sampledToneSineList :: (RealTrans.C a, Module.C a a) =>
NonNeg.T a -> NonNeg.Int -> a -> a -> [a] -> [a] -> Bool
sampledToneSineList periodNN ext origPhase phase shapes freqs =
let ipLeap = Interpolation.cubic
ipStep = Interpolation.cubic
ten = fromInteger 10
period = ten + NonNeg.toNumber periodNN
len = minLength ipLeap ipStep (ceiling period) ext
tone = take len (Osci.staticSine origPhase (recip period))
in all ((< ten ^- (-2)) . abs) $
zipWith (-)
(Osci.shapeFreqMod (Wave.sampledTone ipLeap ipStep period tone)
phase shapes freqs)
(Osci.freqModSine (origPhase+phase) freqs)
sampledToneLinear :: (RealField.C a, Module.C a v, Eq v) =>
InterpolationTest.LinePreserving a v ->
InterpolationTest.LinePreserving a v ->
NonNeg.T a -> NonNeg.Int -> (v,v) -> a -> Phase.T a -> Property
sampledToneLinear =
withLPInterpolation $ \ ipLeap ->
withLPInterpolation $ \ ipStep ->
\ periodNN ext (i,d) shape phase ->
let period = NonNeg.toNumber periodNN
len = minLength ipLeap ipStep (ceiling period) ext
ramp = take len (List.iterate (d+) i)
limits =
mapPair (fromIntegral, fromIntegral) $
ToneMod.shapeLimits ipLeap ipStep (round period) len
in period /= zero ==>
-- should be (fraction phase), right?
Wave.sampledTone ipLeap ipStep period ramp shape `Wave.apply` phase ==
i + uncurry clip limits shape *> d
{-
let len=100; period=1/0.06::Double; ip = Interpolation.linear in GNUPlot.plotFuncs [] (GNUPlot.linearScale 1000 (0,fromIntegral len)) [\s -> Wave.sampledTone ip ip period (take len $ iterate (1+) (0::Double)) s 0, uncurry clip (mapPair (fromIntegral, fromIntegral) $ Wave.shapeLimits ip ip (round period::Int) len)]
-}
sampledToneStair :: (RealField.C a, Module.C a v, Eq v) =>
InterpolationTest.LinePreserving a v ->
NonNeg.Int -> NonNeg.Int -> (v,v) -> a -> Property
sampledToneStair =
withLPInterpolation $ \ ipLeap
periodIntNN ext (i,d) shape ->
let ipStep = Interpolation.constant
periodInt = NonNeg.toNumber periodIntNN
period = fromIntegral periodInt
len0 = minLength ipLeap ipStep periodInt ext
(rep,rm) = divMod (negate len0) periodInt
len = len0 + rm
stair =
concatMap (replicate periodInt) $
take (negate rep) (List.iterate (period*>d+) i)
limits =
mapPair (fromIntegral, fromIntegral) $
ToneMod.shapeLimits ipLeap ipStep periodInt len
in periodInt /= zero ==>
Wave.sampledTone ipLeap ipStep period stair shape `Wave.apply` zero ==
i + uncurry clip limits shape *> d
{-
let len=periodInt*rep; rep=10; periodInt = 14::Int; period=fromIntegral periodInt; ipl = Interpolation.linear; ipc = Interpolation.constant in GNUPlot.plotFuncs [] (GNUPlot.linearScale 1000 (-10,10+fromIntegral len)) [\s -> Wave.sampledTone ipl ipc period (concatMap (replicate periodInt) $ take rep $ iterate (period+) (0::Double)) s 0, uncurry clip (mapPair (fromIntegral, fromIntegral) $ Wave.shapeLimits ipl ipc periodInt len)]
-}
{-
sampledToneSaw :: (RealField.C a, Module.C a v, Eq v) =>
InterpolationTest.LinePreserving a v ->
InterpolationTest.T a v ->
NonNeg.Int -> NonNeg.Int -> (v,v) -> a -> a -> Property
sampledToneSaw iptLeap iptStep periodIntNN ext (i,d) shape phase =
let ipLeap = InterpolationTest.lpIp iptLeap
ipStep = InterpolationTest.ip iptStep
periodInt = NonNeg.toNumber periodIntNN
period = fromIntegral periodInt
len0 = minLength ipLeap ipStep periodInt ext
rep = negate $ div (negate len0) periodInt
saw =
concat $ replicate rep $
take periodInt $ List.iterate (d+) i
in periodInt /= zero ==>
Wave.sampledTone ipLeap ipStep period saw shape phase ==
i + fraction phase *> d
-}
sampledToneStatic :: (RealField.C a, Eq v) =>
InterpolationTest.T a v ->
InterpolationTest.T a v ->
NonNeg.Int -> (v,[v]) -> a -> a -> Property
sampledToneStatic =
withInterpolation2 $ \ ipLeap ipStep
ext (x,xs) shape phase ->
let wave = x:xs
periodInt = length wave
period = fromIntegral periodInt
len = minLength ipLeap ipStep periodInt ext
rep = negate $ div (negate len) periodInt
tone = concat $ replicate rep wave
in period /= zero ==>
Wave.sampledTone ipLeap ipStep period tone shape `Wave.apply` (Phase.fromRepresentative phase) ==
Interpolation.cyclicPad Interpolation.single ipStep (phase*period) wave
{-
let wave = [1,-1,0.5,-0.5::Double]; period = fromIntegral (length wave) :: Double; ip = Interpolation.linear in GNUPlot.plotFuncs [] (GNUPlot.linearScale 1000 (-1,3)) [Wave.sampledTone ip ip period (concat $ replicate 3 wave) 0.3, \phase -> Interpolation.cyclicPad Interpolation.single Interpolation.linear (phase*period) wave]
-}
-- candidate for Utility
zapWith :: (a -> a -> b) -> [a] -> [b]
zapWith f xs = zipWith f xs (tail xs)
-- candidate for Utility
monotoniclyIncreasing :: Ord a => [a] -> Bool
monotoniclyIncreasing [] = True
monotoniclyIncreasing xs = and $ zapWith (<=) xs
shapeFreqModFromSampledToneLimitIdentity :: (RealField.C t) =>
InterpolationTest.T t y ->
InterpolationTest.T t y ->
NonNeg.Int -> (y,[y]) -> (t, [NonNeg.T t]) -> Bool
shapeFreqModFromSampledToneLimitIdentity =
withInterpolation2 $ \ ipLeap ipStep
periodIntNN (x,xs) (shape0,shapesNN) ->
let periodInt = NonNeg.toNumber periodIntNN
shapes = map NonNeg.toNumber shapesNN
a =
snd (ToneMod.limitRelativeShapes
ipLeap ipStep periodInt (List.cycle (x:xs))
(shape0, cycle (zero:shapes))) !! 100
in a == a
oscillatorCoords :: (RealField.C t) =>
NonNeg.Int -> NonNeg.T t -> t -> Phase.T t -> [NonNeg.T t] -> [t] -> Property
oscillatorCoords
periodIntNN periodNN shape0 phase shapesNN freqs =
let shapes = map NonNeg.toNumber shapesNN
period = NonNeg.toNumber periodNN
periodInt = NonNeg.toNumber periodIntNN
periodRound = fromIntegral periodInt
coords =
ToneMod.oscillatorCoords
periodInt period
(shape0, shapes) (phase, freqs)
in period /= zero && periodInt /= zero ==>
all
(\(skip,(k,(qShape,qWave))) ->
skip >= zero &&
monotoniclyIncreasing [negate periodInt, k, zero] &&
monotoniclyIncreasing [zero, qShape, one] &&
monotoniclyIncreasing [zero, qWave, periodRound])
(tail coords)
shapeFreqModFromSampledToneCoordsIdentity :: (RealField.C t) =>
NonNeg.Int -> NonNeg.T t -> (t, [NonNeg.T t]) -> Property
shapeFreqModFromSampledToneCoordsIdentity
periodIntNN periodNN (shape0,shapesNN) =
let period = NonNeg.toNumber periodNN
periodInt = NonNeg.toNumber periodIntNN
shapes = map NonNeg.toNumber shapesNN
phase = Phase.fromRepresentative $ shape0 / period
freqs = map (/period) shapes
in period /= zero ==>
all
(isZero . fst . snd . snd)
(ToneMod.oscillatorCoords
periodInt period (shape0, shapes) (phase, freqs))
shapeFreqModFromSampledTone :: (RealField.C t, Eq v) =>
InterpolationTest.T t v ->
InterpolationTest.T t v ->
NonNeg.T t ->
NonNeg.Int -> (v,[v]) ->
t -> t -> [NonNeg.T t] -> [t] ->
Property
shapeFreqModFromSampledTone =
withInterpolation2 $ \ ipLeap ipStep
periodNN ext (x,xs) shape0 phase shapesNN freqs ->
let shapes = map NonNeg.toNumber shapesNN
period = NonNeg.toNumber periodNN
len = minLength ipLeap ipStep (ceiling period) ext
tone = take len (List.cycle (x:xs))
resampledToneA =
Osci.shapeFreqModFromSampledTone ipLeap ipStep period tone
shape0 phase shapes freqs
resampledToneB =
Osci.shapeFreqMod
(Wave.sampledTone ipLeap ipStep period tone)
phase (scanl (+) shape0 shapes) freqs
in period /= zero ==>
resampledToneA == resampledToneB
{-
let len=100; period=1/0.06::Double; ip = Interpolation.linear; tone = take len $ iterate (1+) (0::Double); shape0=0; shapes = replicate 100 1; in GNUPlot.plotLists [] [Osci.shapeFreqMod (Wave.sampledTone ip ip period tone) 0 (scanl (+) shape0 shapes) (repeat 0), Osci.shapeFreqModFromSampledTone ip ip period tone shape0 0 shapes (repeat 0)]
*Test.Sound.Synthesizer.Plain.Oscillator> let len=100; period=1/0.06::Double; ip = Interpolation.linear; tone = take len $ iterate (1+) (0::Double); shape0=0; shapes = concat $ replicate 50 [1.5,0.5]; in GNUPlot.plotLists [] [Osci.shapeFreqMod (Wave.sampledTone ip ip period tone) 0 (scanl (+) shape0 shapes) (repeat 0), Osci.shapeFreqModFromSampledTone ip ip period tone shape0 0 shapes (repeat 0)]
*Test.Sound.Synthesizer.Plain.Oscillator> let len=100; period=1/0.06::Rational; ipLeap = Interpolation.linear; ipStep = Interpolation.constant; tone = take len $ iterate (1+) (0::Rational); shape0=0; shapes = concat $ replicate 50 [1.5,0.5]; in GNUPlot.plotLists [] (map (map (\x -> fromRational' x :: Double)) [Osci.shapeFreqMod (Wave.sampledTone ipLeap ipStep period tone) 0 (scanl (+) shape0 shapes) (repeat 0), Osci.shapeFreqModFromSampledTone ipLeap ipStep period tone shape0 0 shapes (repeat 0)])
-}
oscillatorCells :: (RealField.C t, Eq v) =>
InterpolationTest.T t v ->
InterpolationTest.T t v ->
NonNeg.T t ->
NonNeg.Int -> (v,[v]) ->
t -> t -> [NonNeg.T t] -> [t] ->
Property
oscillatorCells =
withInterpolation2 $ \ ipLeap ipStep
periodNN ext (x,xs) shape0 phase shapesNN freqs ->
let shapes = map NonNeg.toNumber shapesNN
period = NonNeg.toNumber periodNN
len = minLength ipLeap ipStep (ceiling period) ext
tone = take len (List.cycle (x:xs))
crop = cropCell ipLeap ipStep
resampledToneA =
ToneMod.oscillatorCells ipLeap ipStep period tone
(shape0, shapes) (Phase.fromRepresentative phase, freqs)
resampledToneB =
Osci.shapeFreqMod
(Wave.Cons . ToneMod.sampledToneCell
(ToneMod.makePrototype ipLeap ipStep period tone))
phase (scanl (+) shape0 shapes) freqs
in period /= zero ==>
map crop resampledToneA == map crop resampledToneB
cropCell ::
Interpolation.T t v ->
Interpolation.T t v ->
((t,t),[[v]]) -> ((t,t),[[v]])
cropCell ipLeap ipStep (q,cell) =
(q,
take (Interpolation.number ipStep) $
map (take (Interpolation.number ipLeap)) $
cell)
shapeFreqModFromSampledToneIdentity :: (RealField.C t, Eq v) =>
InterpolationTest.T t v ->
InterpolationTest.T t v ->
NonNeg.T t ->
NonNeg.Int -> (v,[v]) ->
Property
shapeFreqModFromSampledToneIdentity =
withInterpolation2 $ \ ipLeap ipStep
periodNN ext (x,xs) ->
let period = NonNeg.toNumber periodNN
len = minLength ipLeap ipStep (ceiling period) ext
tone = take len (List.cycle (x:xs))
shape0 = zero
shapes = repeat one
phase = zero
freqs = repeat (recip period)
(n0,n1) =
ToneMod.shapeLimits ipLeap ipStep (round period) len
resampledTone =
Osci.shapeFreqModFromSampledTone ipLeap ipStep period tone
shape0 phase shapes freqs
in period /= zero ==>
and (drop n0 (take (succ n1) (zipWith (==) resampledTone tone)))
testRationalLineIp :: Testable test =>
(InterpolationTest.LinePreserving Rational Rational -> test) -> IO ()
testRationalLineIp f = test f
testRationalIp :: Testable test =>
(InterpolationTest.T Rational Rational -> test) -> IO ()
testRationalIp f = test f
tests :: [(String, IO ())]
tests =
("untangleShapePhase",
test (\periodInt period ->
untangleShapePhase periodInt (period :: Rational))) :
("limitMinRelativeValues", test limitMinRelativeValues) :
("limitMaxRelativeValues", test limitMaxRelativeValues) :
("limitMaxRelativeValuesNonNeg",
test limitMaxRelativeValuesNonNeg) :
("limitMinRelativeValuesIdentity",
test limitMinRelativeValuesIdentity) :
("limitMaxRelativeValuesIdentity",
test limitMaxRelativeValuesIdentity) :
("limitMaxRelativeValuesNonNegIdentity",
test limitMaxRelativeValuesNonNegIdentity) :
("limitMaxRelativeValuesInfinity",
test limitMaxRelativeValuesInfinity) :
("limitMaxRelativeValuesNonNegInfinity",
test limitMaxRelativeValuesNonNegInfinity) :
("dropRem", test (dropRem :: Int -> [Double] -> Bool)) :
("sampledTone",
testRationalIp sampledTone) :
("sampledToneSine",
test (\period -> sampledToneSine (period :: NonNeg.Double))) :
("sampledToneSineList",
test (\period -> sampledToneSineList (period :: NonNeg.Double))) :
("sampledToneLinear",
testRationalLineIp sampledToneLinear) :
("sampledToneStair",
testRationalLineIp sampledToneStair) :
{-
("sampledToneSaw",
testRationalLineIp sampledToneSaw) :
-}
("sampledToneStatic",
testRationalIp sampledToneStatic) :
("shapeFreqModFromSampledToneLimitIdentity",
testRationalIp shapeFreqModFromSampledToneLimitIdentity) :
("oscillatorCoords",
test (\periodInt period ->
oscillatorCoords
periodInt (period :: NonNeg.Rational))) :
("shapeFreqModFromSampledToneCoordsIdentity",
test (\periodInt period ->
shapeFreqModFromSampledToneCoordsIdentity
periodInt (period :: NonNeg.Rational))) :
("shapeFreqModFromSampledTone",
testRationalIp shapeFreqModFromSampledTone) :
("oscillatorCells",
testRationalIp oscillatorCells) :
("shapeFreqModFromSampledToneIdentity",
testRationalIp shapeFreqModFromSampledToneIdentity) :
[]