module Synthesizer.Interpolation.Module (
T,
constant,
linear,
cubic,
cubicAlt,
piecewise,
piecewiseConstant,
piecewiseLinear,
piecewiseCubic,
function,
) where
import qualified Synthesizer.State.Signal as Sig
import qualified Synthesizer.Plain.Control as Ctrl
import Synthesizer.Interpolation (
T, cons, getNode, fromPrefixReader,
constant,
)
import qualified Algebra.Module as Module
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import Algebra.Module((*>))
import Control.Applicative (liftA2, )
import Synthesizer.ApplicativeUtility (liftA4, )
import Synthesizer.Utility (affineComb, )
import NumericPrelude.Base
import NumericPrelude.Numeric
linear :: (Module.C t y) => T t y
linear =
fromPrefixReader "linear" 0
(liftA2
(\x0 x1 phase -> affineComb phase (x0,x1))
getNode getNode)
cubic :: (Field.C t, Module.C t y) => T t y
cubic =
fromPrefixReader "cubic" 1
(liftA4
(\xm1 x0 x1 x2 t ->
let lipm12 = affineComb t (xm1,x2)
lip01 = affineComb t (x0, x1)
three = 3 `asTypeOf` t
in lip01 + (t*(t1)/2) *>
(lipm12 + (x0+x1) three *> lip01))
getNode getNode getNode getNode)
cubicAlt :: (Field.C t, Module.C t y) => T t y
cubicAlt =
fromPrefixReader "cubicAlt" 1
(liftA4
(\xm1 x0 x1 x2 t ->
let half = 1/2 `asTypeOf` t
in cubicHalf t x0 (half *> (x1xm1)) +
cubicHalf (1t) x1 (half *> (x0x2)))
getNode getNode getNode getNode)
cubicHalf :: (Module.C t y) => t -> y -> y -> y
cubicHalf t x x' =
(t1)^2 *> ((1+2*t)*>x + t*>x')
piecewise :: (Module.C t y) =>
Int -> [t -> t] -> T t y
piecewise center ps =
cons (length ps) (center1)
(\t -> Sig.linearComb (Sig.fromList (map ($t) (reverse ps))))
piecewiseConstant :: (Module.C t y) => T t y
piecewiseConstant =
piecewise 1 [const 1]
piecewiseLinear :: (Module.C t y) => T t y
piecewiseLinear =
piecewise 1 [id, (1)]
piecewiseCubic :: (Field.C t, Module.C t y) => T t y
piecewiseCubic =
piecewise 2 $
Ctrl.cubicFunc (0,(0,0)) (1,(0,1/2)) :
Ctrl.cubicFunc (0,(0,1/2)) (1,(1,0)) :
Ctrl.cubicFunc (0,(1,0)) (1,(0,1/2)) :
Ctrl.cubicFunc (0,(0,1/2)) (1,(0,0)) :
[]
function :: (Module.C t y) =>
(Int,Int)
-> (t -> t)
-> T t y
function (left,right) f =
let len = left+right
ps = Sig.take len $ Sig.iterate pred (pred right)
in cons len left
(\t -> Sig.linearComb $
Sig.map (\x -> f (t + fromIntegral x)) ps)