{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Interpolation.Class where
import qualified Synthesizer.State.Signal as Sig
import qualified Algebra.Module as Module
import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.Ring as Ring
import qualified Sound.Frame.NumericPrelude.Stereo as Stereo
import qualified Number.Ratio as Ratio
import qualified Number.Complex as Complex
import Control.Applicative (Applicative(pure, (<*>)), liftA2, )
import Data.Tuple.HT (mapPair, mapSnd, fst3, snd3, thd3, )
import NumericPrelude.Numeric hiding (zero, )
import NumericPrelude.Base
import Prelude ()
class Ring.C a => C a v where
scaleAndAccumulate :: (a,v) -> (v, v -> v)
instance C Float Float where
{-# INLINE scaleAndAccumulate #-}
scaleAndAccumulate :: (Float, Float) -> (Float, Float -> Float)
scaleAndAccumulate = forall a. C a => (a, a) -> (a, a -> a)
scaleAndAccumulateRing
instance C Double Double where
{-# INLINE scaleAndAccumulate #-}
scaleAndAccumulate :: (Double, Double) -> (Double, Double -> Double)
scaleAndAccumulate = forall a. C a => (a, a) -> (a, a -> a)
scaleAndAccumulateRing
instance (C a v) => C a (Complex.T v) where
{-# INLINE scaleAndAccumulate #-}
scaleAndAccumulate :: (a, T v) -> (T v, T v -> T v)
scaleAndAccumulate =
forall a x y v.
(C a x, C a y) =>
(x -> y -> v) -> (v -> x) -> (v -> y) -> (a, v) -> (v, v -> v)
makeMac2 forall a. a -> a -> T a
(Complex.+:) forall a. T a -> a
Complex.real forall a. T a -> a
Complex.imag
instance (PID.C a) => C (Ratio.T a) (Ratio.T a) where
{-# INLINE scaleAndAccumulate #-}
scaleAndAccumulate :: (T a, T a) -> (T a, T a -> T a)
scaleAndAccumulate = forall a. C a => (a, a) -> (a, a -> a)
scaleAndAccumulateRing
instance (C a v, C a w) => C a (v, w) where
{-# INLINE scaleAndAccumulate #-}
scaleAndAccumulate :: (a, (v, w)) -> ((v, w), (v, w) -> (v, w))
scaleAndAccumulate = forall a x y v.
(C a x, C a y) =>
(x -> y -> v) -> (v -> x) -> (v -> y) -> (a, v) -> (v, v -> v)
makeMac2 (,) forall a b. (a, b) -> a
fst forall a b. (a, b) -> b
snd
instance (C a v, C a w, C a u) => C a (v, w, u) where
{-# INLINE scaleAndAccumulate #-}
scaleAndAccumulate :: (a, (v, w, u)) -> ((v, w, u), (v, w, u) -> (v, w, u))
scaleAndAccumulate = forall a x y z v.
(C a x, C a y, C a z) =>
(x -> y -> z -> v)
-> (v -> x) -> (v -> y) -> (v -> z) -> (a, v) -> (v, v -> v)
makeMac3 (,,) forall a b c. (a, b, c) -> a
fst3 forall a b c. (a, b, c) -> b
snd3 forall a b c. (a, b, c) -> c
thd3
instance C a v => C a (Stereo.T v) where
{-# INLINE scaleAndAccumulate #-}
scaleAndAccumulate :: (a, T v) -> (T v, T v -> T v)
scaleAndAccumulate =
forall a x y v.
(C a x, C a y) =>
(x -> y -> v) -> (v -> x) -> (v -> y) -> (a, v) -> (v, v -> v)
makeMac2 forall a. a -> a -> T a
Stereo.cons forall a. T a -> a
Stereo.left forall a. T a -> a
Stereo.right
infixl 6 +.*
{-# INLINE scale #-}
scale :: C a v => (a,v) -> v
scale :: forall a v. C a v => (a, v) -> v
scale = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a v. C a v => (a, v) -> (v, v -> v)
scaleAndAccumulate
{-# INLINE scaleAccumulate #-}
scaleAccumulate :: C a v => (a,v) -> v -> v
scaleAccumulate :: forall a v. C a v => (a, v) -> v -> v
scaleAccumulate = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a v. C a v => (a, v) -> (v, v -> v)
scaleAndAccumulate
{-# INLINE (+.*) #-}
(+.*) :: C a v => v -> (a,v) -> v
+.* :: forall a v. C a v => v -> (a, v) -> v
(+.*) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a v. C a v => (a, v) -> v -> v
scaleAccumulate
combine2 :: C a v => a -> (v, v) -> v
combine2 :: forall a v. C a v => a -> (v, v) -> v
combine2 a
a (v
x,v
y) =
forall a v. C a v => (a, v) -> v -> v
scaleAccumulate (forall a. C a => a
oneforall a. C a => a -> a -> a
-a
a, v
x) forall a b. (a -> b) -> a -> b
$
forall a v. C a v => (a, v) -> v
scale (a
a, v
y)
combineMany :: C a v => (a, Sig.T a) -> (v, Sig.T v) -> v
combineMany :: forall a v. C a v => (a, T a) -> (v, T v) -> v
combineMany (a
a,T a
as) (v
v,T v
vs) =
forall acc x. (acc -> x -> acc) -> acc -> T x -> acc
Sig.foldL (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a v. C a v => (a, v) -> v -> v
scaleAccumulate) (forall a v. C a v => (a, v) -> v
scale (a
a,v
v)) forall a b. (a -> b) -> a -> b
$
forall a b. T a -> T b -> T (a, b)
Sig.zip T a
as T v
vs
{-# INLINE scaleAndAccumulateRing #-}
scaleAndAccumulateRing ::
Ring.C a =>
(a,a) -> (a, a -> a)
scaleAndAccumulateRing :: forall a. C a => (a, a) -> (a, a -> a)
scaleAndAccumulateRing (a
a,a
x) =
let ax :: a
ax = a
a forall a. C a => a -> a -> a
* a
x
in (a
ax, (a
axforall a. C a => a -> a -> a
+))
{-# INLINE scaleAndAccumulateModule #-}
scaleAndAccumulateModule ::
Module.C a v =>
(a,v) -> (v, v -> v)
scaleAndAccumulateModule :: forall a v. C a v => (a, v) -> (v, v -> v)
scaleAndAccumulateModule (a
a,v
x) =
let ax :: v
ax = a
a forall a v. C a v => a -> v -> v
*> v
x
in (v
ax, (v
axforall a. C a => a -> a -> a
+))
{-# INLINE scaleAndAccumulateApplicative #-}
scaleAndAccumulateApplicative ::
(C a v, Applicative f) =>
(a, f v) -> (f v, f v -> f v)
scaleAndAccumulateApplicative :: forall a v (f :: * -> *).
(C a v, Applicative f) =>
(a, f v) -> (f v, f v -> f v)
scaleAndAccumulateApplicative (a
a,f v
x) =
let ax :: f (v, v -> v)
ax = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall a v. C a v => (a, v) -> (v, v -> v)
scaleAndAccumulate a
a) f v
x
in (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst f (v, v -> v)
ax, (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd f (v, v -> v)
ax forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>))
{-# INLINE scaleAndAccumulateRingApplicative #-}
scaleAndAccumulateRingApplicative ::
(Ring.C a, Applicative f) =>
(a, f a) -> (f a, f a -> f a)
scaleAndAccumulateRingApplicative :: forall a (f :: * -> *).
(C a, Applicative f) =>
(a, f a) -> (f a, f a -> f a)
scaleAndAccumulateRingApplicative (a
a,f a
x) =
let ax :: f a
ax = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
aforall a. C a => a -> a -> a
*) f a
x
in (f a
ax, forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. C a => a -> a -> a
(+) f a
ax)
{-# INLINE scaleAndAccumulateModuleApplicative #-}
scaleAndAccumulateModuleApplicative ::
(Module.C a v, Applicative f) =>
(a, f v) -> (f v, f v -> f v)
scaleAndAccumulateModuleApplicative :: forall a v (f :: * -> *).
(C a v, Applicative f) =>
(a, f v) -> (f v, f v -> f v)
scaleAndAccumulateModuleApplicative (a
a,f v
x) =
let ax :: f v
ax = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
aforall a v. C a v => a -> v -> v
*>) f v
x
in (f v
ax, forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. C a => a -> a -> a
(+) f v
ax)
newtype MAC a v x = MAC {forall a v x. MAC a v x -> (a, v) -> (x, v -> x)
runMac :: (a,v) -> (x, v -> x)}
{-# INLINE element #-}
element ::
(C a x) =>
(v -> x) -> MAC a v x
element :: forall a x v. C a x => (v -> x) -> MAC a v x
element v -> x
f =
forall a v x. ((a, v) -> (x, v -> x)) -> MAC a v x
MAC forall a b. (a -> b) -> a -> b
$ \(a
a,v
x) ->
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall b c a. (b -> c) -> (a -> b) -> a -> c
.v -> x
f) forall a b. (a -> b) -> a -> b
$ forall a v. C a v => (a, v) -> (v, v -> v)
scaleAndAccumulate (a
a, v -> x
f v
x)
instance Functor (MAC a v) where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> MAC a v a -> MAC a v b
fmap a -> b
f (MAC (a, v) -> (a, v -> a)
x) =
forall a v x. ((a, v) -> (x, v -> x)) -> MAC a v x
MAC forall a b. (a -> b) -> a -> b
$ forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (a -> b
f, (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, v) -> (a, v -> a)
x
instance Applicative (MAC a v) where
{-# INLINE pure #-}
{-# INLINE (<*>) #-}
pure :: forall a. a -> MAC a v a
pure a
x = forall a v x. ((a, v) -> (x, v -> x)) -> MAC a v x
MAC forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (a
x, forall a b. a -> b -> a
const a
x)
MAC (a, v) -> (a -> b, v -> a -> b)
f <*> :: forall a b. MAC a v (a -> b) -> MAC a v a -> MAC a v b
<*> MAC (a, v) -> (a, v -> a)
x =
forall a v x. ((a, v) -> (x, v -> x)) -> MAC a v x
MAC forall a b. (a -> b) -> a -> b
$ \(a, v)
av ->
let (a
xav,v -> a
add) = (a, v) -> (a, v -> a)
x (a, v)
av
(a -> b
g,v -> a -> b
fadd) = (a, v) -> (a -> b, v -> a -> b)
f (a, v)
av
in (a -> b
g a
xav, \v
y -> v -> a -> b
fadd v
y (v -> a
add v
y))
{-# INLINE makeMac #-}
makeMac ::
(C a x) =>
(x -> v) ->
(v -> x) ->
(a,v) -> (v, v -> v)
makeMac :: forall a x v.
C a x =>
(x -> v) -> (v -> x) -> (a, v) -> (v, v -> v)
makeMac x -> v
cons v -> x
x =
forall a v x. MAC a v x -> (a, v) -> (x, v -> x)
runMac forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure x -> v
cons forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a x v. C a x => (v -> x) -> MAC a v x
element v -> x
x
{-# INLINE makeMac2 #-}
makeMac2 ::
(C a x, C a y) =>
(x -> y -> v) ->
(v -> x) -> (v -> y) ->
(a,v) -> (v, v -> v)
makeMac2 :: forall a x y v.
(C a x, C a y) =>
(x -> y -> v) -> (v -> x) -> (v -> y) -> (a, v) -> (v, v -> v)
makeMac2 x -> y -> v
cons v -> x
x v -> y
y =
forall a v x. MAC a v x -> (a, v) -> (x, v -> x)
runMac forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure x -> y -> v
cons forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a x v. C a x => (v -> x) -> MAC a v x
element v -> x
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a x v. C a x => (v -> x) -> MAC a v x
element v -> y
y
{-# INLINE makeMac3 #-}
makeMac3 ::
(C a x, C a y, C a z) =>
(x -> y -> z -> v) ->
(v -> x) -> (v -> y) -> (v -> z) ->
(a,v) -> (v, v -> v)
makeMac3 :: forall a x y z v.
(C a x, C a y, C a z) =>
(x -> y -> z -> v)
-> (v -> x) -> (v -> y) -> (v -> z) -> (a, v) -> (v, v -> v)
makeMac3 x -> y -> z -> v
cons v -> x
x v -> y
y v -> z
z =
forall a v x. MAC a v x -> (a, v) -> (x, v -> x)
runMac forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure x -> y -> z -> v
cons forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a x v. C a x => (v -> x) -> MAC a v x
element v -> x
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a x v. C a x => (v -> x) -> MAC a v x
element v -> y
y forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a x v. C a x => (v -> x) -> MAC a v x
element v -> z
z