module Synthesizer.Generic.Cyclic where
import qualified Synthesizer.Generic.Filter.NonRecursive as FiltNRG
import qualified Synthesizer.Generic.Analysis as AnaG
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Generic.Cut as CutG
import qualified Synthesizer.State.Signal as Sig
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()
fromSignal ::
(SigG.Write sig yv, Additive.C yv) =>
SigG.LazySize -> Int -> sig yv -> sig yv
fromSignal :: forall (sig :: * -> *) yv.
(Write sig yv, C yv) =>
LazySize -> Int -> sig yv -> sig yv
fromSignal LazySize
chunkSize Int
n =
(sig yv -> sig yv -> sig yv) -> sig yv -> T (sig yv) -> sig yv
forall acc x. (acc -> x -> acc) -> acc -> T x -> acc
Sig.foldL sig yv -> sig yv -> sig yv
forall y (sig :: * -> *).
(C y, Transform sig y) =>
sig y -> sig y -> sig y
SigG.mix (LazySize -> Int -> yv -> sig yv
forall y. Storage (sig y) => LazySize -> Int -> y -> sig y
forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> Int -> y -> sig y
SigG.replicate LazySize
chunkSize Int
n yv
forall a. C a => a
zero) (T (sig yv) -> sig yv)
-> (sig yv -> T (sig yv)) -> sig yv -> sig yv
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> sig yv -> T (sig yv)
forall sig. Transform sig => Int -> sig -> T sig
CutG.sliceVertical Int
n
reverse ::
(SigG.Transform sig y) =>
sig y -> sig y
reverse :: forall (sig :: * -> *) y. Transform sig y => sig y -> sig y
reverse sig y
sig =
sig y -> (y -> sig y -> sig y) -> sig y -> sig y
forall (sig :: * -> *) y a.
Transform sig y =>
a -> (y -> sig y -> a) -> sig y -> a
SigG.switchL sig y
sig
(\y
y sig y
ys -> y -> sig y -> sig y
forall y. Storage (sig y) => y -> sig y -> sig y
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
y -> sig y -> sig y
SigG.cons y
y (sig y -> sig y
forall sig. Transform sig => sig -> sig
SigG.reverse sig y
ys)) sig y
sig
reperiodize ::
(SigG.Transform sig yv, Additive.C yv) =>
Int -> sig yv -> sig yv
reperiodize :: forall (sig :: * -> *) yv.
(Transform sig yv, C yv) =>
Int -> sig yv -> sig yv
reperiodize Int
n =
(sig yv -> sig yv -> sig yv) -> sig yv -> T (sig yv) -> sig yv
forall acc x. (acc -> x -> acc) -> acc -> T x -> acc
Sig.foldL sig yv -> sig yv -> sig yv
forall y (sig :: * -> *).
(C y, Transform sig y) =>
sig y -> sig y -> sig y
SigG.mix sig yv
forall sig. Monoid sig => sig
CutG.empty (T (sig yv) -> sig yv)
-> (sig yv -> T (sig yv)) -> sig yv -> sig yv
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> sig yv -> T (sig yv)
forall sig. Transform sig => Int -> sig -> T sig
CutG.sliceVertical Int
n
convolve ::
(SigG.Transform sig y, Ring.C y) =>
sig y -> sig y -> sig y
convolve :: forall (sig :: * -> *) y.
(Transform sig y, C y) =>
sig y -> sig y -> sig y
convolve sig y
x sig y
y =
Int -> sig y -> sig y
forall (sig :: * -> *) yv.
(Transform sig yv, C yv) =>
Int -> sig yv -> sig yv
reperiodize (sig y -> Int
forall sig. Read sig => sig -> Int
CutG.length sig y
x) (sig y -> sig y) -> sig y -> sig y
forall a b. (a -> b) -> a -> b
$
(y -> y -> y) -> sig y -> sig y -> sig y
forall a b c (sig :: * -> *).
(C a, C b, C c, Transform sig a, Transform sig b,
Transform sig c) =>
(a -> b -> c) -> sig a -> sig b -> sig c
FiltNRG.karatsubaFinite y -> y -> y
forall a. C a => a -> a -> a
(*) sig y
x sig y
y
filterNaive ::
(SigG.Transform sig y, Ring.C y) =>
sig y -> sig y -> sig y
filterNaive :: forall (sig :: * -> *) y.
(Transform sig y, C y) =>
sig y -> sig y -> sig y
filterNaive sig y
x sig y
y =
sig y -> T y -> sig y
forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
sig a -> T b -> sig b
SigG.takeStateMatch sig y
y (T y -> sig y) -> T y -> sig y
forall a b. (a -> b) -> a -> b
$
sig y -> T y
forall y. Storage (sig y) => sig y -> T y
forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState (sig y -> T y) -> sig y -> T y
forall a b. (a -> b) -> a -> b
$
(sig y -> y) -> sig y -> sig y
forall (sig :: * -> *) a.
Transform sig a =>
(sig a -> a) -> sig a -> sig a
SigG.mapTails
(sig y -> sig y -> y
forall y (sig :: * -> *). (C y, Read sig y) => sig y -> sig y -> y
AnaG.scalarProduct sig y
x)
(sig y -> sig y -> sig y
forall sig. Monoid sig => sig -> sig -> sig
SigG.append sig y
y sig y
y)
convolveNaive ::
(SigG.Transform sig y, Ring.C y) =>
sig y -> sig y -> sig y
convolveNaive :: forall (sig :: * -> *) y.
(Transform sig y, C y) =>
sig y -> sig y -> sig y
convolveNaive sig y
x sig y
y =
sig y -> T y -> sig y
forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
sig a -> T b -> sig b
SigG.takeStateMatch sig y
y (T y -> sig y) -> T y -> sig y
forall a b. (a -> b) -> a -> b
$
sig y -> T y
forall y. Storage (sig y) => sig y -> T y
forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState (sig y -> T y) -> sig y -> T y
forall a b. (a -> b) -> a -> b
$
(sig y -> y) -> sig y -> sig y
forall (sig :: * -> *) a.
Transform sig a =>
(sig a -> a) -> sig a -> sig a
SigG.mapTails
(sig y -> sig y -> y
forall y (sig :: * -> *). (C y, Read sig y) => sig y -> sig y -> y
AnaG.scalarProduct (sig y -> sig y
forall sig. Transform sig => sig -> sig
SigG.reverse sig y
x))
(sig y -> sig y
forall (sig :: * -> *) y. Transform sig y => sig y -> sig y
SigG.laxTail (sig y -> sig y) -> sig y -> sig y
forall a b. (a -> b) -> a -> b
$ sig y -> sig y -> sig y
forall sig. Monoid sig => sig -> sig -> sig
SigG.append sig y
y sig y
y)
type Pair y = (y,y)
{-# INLINE convolvePair #-}
convolvePair ::
(Ring.C y) =>
Pair y -> Pair y -> Pair y
convolvePair :: forall y. C y => Pair y -> Pair y -> Pair y
convolvePair Pair y
a Pair y
b =
(Pair y, Pair y) -> Pair y
forall a b. (a, b) -> b
snd ((Pair y, Pair y) -> Pair y) -> (Pair y, Pair y) -> Pair y
forall a b. (a -> b) -> a -> b
$ Pair y -> Pair y -> (Pair y, Pair y)
forall y. C y => Pair y -> Pair y -> (Pair y, Pair y)
sumAndConvolvePair Pair y
a Pair y
b
{-# INLINE sumAndConvolvePair #-}
sumAndConvolvePair ::
(Ring.C y) =>
Pair y -> Pair y -> ((y,y), Pair y)
sumAndConvolvePair :: forall y. C y => Pair y -> Pair y -> (Pair y, Pair y)
sumAndConvolvePair (y
a0,y
a1) (y
b0,y
b1) =
let sa01 :: y
sa01 = y
a0y -> y -> y
forall a. C a => a -> a -> a
+y
a1
sb01 :: y
sb01 = y
b0y -> y -> y
forall a. C a => a -> a -> a
+y
b1
ab0ab1 :: y
ab0ab1 = y
a0y -> y -> y
forall a. C a => a -> a -> a
*y
b0y -> y -> y
forall a. C a => a -> a -> a
+y
a1y -> y -> y
forall a. C a => a -> a -> a
*y
b1
in ((y
sa01, y
sb01), (y
ab0ab1, y
sa01y -> y -> y
forall a. C a => a -> a -> a
*y
sb01y -> y -> y
forall a. C a => a -> a -> a
-y
ab0ab1))
type Triple y = (y,y,y)
{-# INLINE convolveTriple #-}
convolveTriple ::
(Ring.C y) =>
Triple y -> Triple y -> Triple y
convolveTriple :: forall y. C y => Triple y -> Triple y -> Triple y
convolveTriple Triple y
a Triple y
b =
((y, y), Triple y) -> Triple y
forall a b. (a, b) -> b
snd (((y, y), Triple y) -> Triple y) -> ((y, y), Triple y) -> Triple y
forall a b. (a -> b) -> a -> b
$ Triple y -> Triple y -> ((y, y), Triple y)
forall y. C y => Triple y -> Triple y -> ((y, y), Triple y)
sumAndConvolveTriple Triple y
a Triple y
b
{-# INLINE sumAndConvolveTriple #-}
sumAndConvolveTriple ::
(Ring.C y) =>
Triple y -> Triple y -> ((y,y), Triple y)
sumAndConvolveTriple :: forall y. C y => Triple y -> Triple y -> ((y, y), Triple y)
sumAndConvolveTriple (y
a0,y
a1,y
a2) (y
b0,y
b1,y
b2) =
let ab0 :: y
ab0 = y
a0y -> y -> y
forall a. C a => a -> a -> a
*y
b0
dab12 :: y
dab12 = y
a1y -> y -> y
forall a. C a => a -> a -> a
*y
b1 y -> y -> y
forall a. C a => a -> a -> a
- y
a2y -> y -> y
forall a. C a => a -> a -> a
*y
b2
sa01 :: y
sa01 = y
a0y -> y -> y
forall a. C a => a -> a -> a
+y
a1; sb01 :: y
sb01 = y
b0y -> y -> y
forall a. C a => a -> a -> a
+y
b1; tab01 :: y
tab01 = y
sa01y -> y -> y
forall a. C a => a -> a -> a
*y
sb01 y -> y -> y
forall a. C a => a -> a -> a
- y
ab0
sa02 :: y
sa02 = y
a0y -> y -> y
forall a. C a => a -> a -> a
+y
a2; sb02 :: y
sb02 = y
b0y -> y -> y
forall a. C a => a -> a -> a
+y
b2; tab02 :: y
tab02 = y
sa02y -> y -> y
forall a. C a => a -> a -> a
*y
sb02 y -> y -> y
forall a. C a => a -> a -> a
- y
ab0
sa012 :: y
sa012 = y
sa01y -> y -> y
forall a. C a => a -> a -> a
+y
a2
sb012 :: y
sb012 = y
sb01y -> y -> y
forall a. C a => a -> a -> a
+y
b2
d0 :: y
d0 = y
sa012y -> y -> y
forall a. C a => a -> a -> a
*y
sb012 y -> y -> y
forall a. C a => a -> a -> a
- y
tab01 y -> y -> y
forall a. C a => a -> a -> a
- y
tab02
d1 :: y
d1 = y
tab01 y -> y -> y
forall a. C a => a -> a -> a
- y
dab12
d2 :: y
d2 = y
tab02 y -> y -> y
forall a. C a => a -> a -> a
+ y
dab12
in ((y
sa012, y
sb012), (y
d0, y
d1, y
d2))
{-# INLINE sumAndConvolveTripleAlt #-}
sumAndConvolveTripleAlt ::
(Ring.C y) =>
Triple y -> Triple y -> ((y,y), Triple y)
sumAndConvolveTripleAlt :: forall y. C y => Triple y -> Triple y -> ((y, y), Triple y)
sumAndConvolveTripleAlt (y
a0,y
a1,y
a2) (y
b0,y
b1,y
b2) =
let ab0 :: y
ab0 = y
a0y -> y -> y
forall a. C a => a -> a -> a
*y
b0
ab1 :: y
ab1 = y
a1y -> y -> y
forall a. C a => a -> a -> a
*y
b1
ab2 :: y
ab2 = y
a2y -> y -> y
forall a. C a => a -> a -> a
*y
b2
sa01 :: y
sa01 = y
a0y -> y -> y
forall a. C a => a -> a -> a
+y
a1; sb01 :: y
sb01 = y
b0y -> y -> y
forall a. C a => a -> a -> a
+y
b1
ab01 :: y
ab01 = y
sa01y -> y -> y
forall a. C a => a -> a -> a
*y
sb01 y -> y -> y
forall a. C a => a -> a -> a
- (y
ab0y -> y -> y
forall a. C a => a -> a -> a
+y
ab1)
sa02 :: y
sa02 = y
a0y -> y -> y
forall a. C a => a -> a -> a
+y
a2; sb02 :: y
sb02 = y
b0y -> y -> y
forall a. C a => a -> a -> a
+y
b2
ab02 :: y
ab02 = y
sa02y -> y -> y
forall a. C a => a -> a -> a
*y
sb02 y -> y -> y
forall a. C a => a -> a -> a
- (y
ab0y -> y -> y
forall a. C a => a -> a -> a
+y
ab2)
sa12 :: y
sa12 = y
a1y -> y -> y
forall a. C a => a -> a -> a
+y
a2; sb12 :: y
sb12 = y
b1y -> y -> y
forall a. C a => a -> a -> a
+y
b2
ab12 :: y
ab12 = y
sa12y -> y -> y
forall a. C a => a -> a -> a
*y
sb12 y -> y -> y
forall a. C a => a -> a -> a
- (y
ab1y -> y -> y
forall a. C a => a -> a -> a
+y
ab2)
in ((y
sa01y -> y -> y
forall a. C a => a -> a -> a
+y
a2, y
sb01y -> y -> y
forall a. C a => a -> a -> a
+y
b2), (y
ab0y -> y -> y
forall a. C a => a -> a -> a
+y
ab12, y
ab2y -> y -> y
forall a. C a => a -> a -> a
+y
ab01, y
ab1y -> y -> y
forall a. C a => a -> a -> a
+y
ab02))
type Quadruple y = (y,y,y,y)
{-# INLINE convolveQuadruple #-}
convolveQuadruple ::
(Ring.C y) =>
Quadruple y -> Quadruple y -> Quadruple y
convolveQuadruple :: forall y. C y => Quadruple y -> Quadruple y -> Quadruple y
convolveQuadruple Quadruple y
a Quadruple y
b =
((y, y), Quadruple y) -> Quadruple y
forall a b. (a, b) -> b
snd (((y, y), Quadruple y) -> Quadruple y)
-> ((y, y), Quadruple y) -> Quadruple y
forall a b. (a -> b) -> a -> b
$ Quadruple y -> Quadruple y -> ((y, y), Quadruple y)
forall y.
C y =>
Quadruple y -> Quadruple y -> ((y, y), Quadruple y)
sumAndConvolveQuadruple Quadruple y
a Quadruple y
b
{-# INLINE sumAndConvolveQuadruple #-}
sumAndConvolveQuadruple ::
(Ring.C y) =>
Quadruple y -> Quadruple y -> ((y,y), Quadruple y)
sumAndConvolveQuadruple :: forall y.
C y =>
Quadruple y -> Quadruple y -> ((y, y), Quadruple y)
sumAndConvolveQuadruple (y
a0,y
a1,y
a2,y
a3) (y
b0,y
b1,y
b2,y
b3) =
let ab0 :: y
ab0 = y
a0y -> y -> y
forall a. C a => a -> a -> a
*y
b0
ab1 :: y
ab1 = y
a1y -> y -> y
forall a. C a => a -> a -> a
*y
b1
sa01 :: y
sa01 = y
a0y -> y -> y
forall a. C a => a -> a -> a
+y
a1; sb01 :: y
sb01 = y
b0y -> y -> y
forall a. C a => a -> a -> a
+y
b1
ab01 :: y
ab01 = y
sa01y -> y -> y
forall a. C a => a -> a -> a
*y
sb01 y -> y -> y
forall a. C a => a -> a -> a
- (y
ab0y -> y -> y
forall a. C a => a -> a -> a
+y
ab1)
ab2 :: y
ab2 = y
a2y -> y -> y
forall a. C a => a -> a -> a
*y
b2
ab3 :: y
ab3 = y
a3y -> y -> y
forall a. C a => a -> a -> a
*y
b3
sa23 :: y
sa23 = y
a2y -> y -> y
forall a. C a => a -> a -> a
+y
a3; sb23 :: y
sb23 = y
b2y -> y -> y
forall a. C a => a -> a -> a
+y
b3
ab23 :: y
ab23 = y
sa23y -> y -> y
forall a. C a => a -> a -> a
*y
sb23 y -> y -> y
forall a. C a => a -> a -> a
- (y
ab2y -> y -> y
forall a. C a => a -> a -> a
+y
ab3)
c0 :: y
c0 = y
ab0 y -> y -> y
forall a. C a => a -> a -> a
+ y
ab2 y -> y -> y
forall a. C a => a -> a -> a
- (y
ab1 y -> y -> y
forall a. C a => a -> a -> a
+ y
ab3)
c1 :: y
c1 = y
ab01 y -> y -> y
forall a. C a => a -> a -> a
+ y
ab23
ab02 :: y
ab02 = (y
a0y -> y -> y
forall a. C a => a -> a -> a
+y
a2)y -> y -> y
forall a. C a => a -> a -> a
*(y
b0y -> y -> y
forall a. C a => a -> a -> a
+y
b2)
ab13 :: y
ab13 = (y
a1y -> y -> y
forall a. C a => a -> a -> a
+y
a3)y -> y -> y
forall a. C a => a -> a -> a
*(y
b1y -> y -> y
forall a. C a => a -> a -> a
+y
b3)
sa0123 :: y
sa0123 = y
sa01y -> y -> y
forall a. C a => a -> a -> a
+y
sa23
sb0123 :: y
sb0123 = y
sb01y -> y -> y
forall a. C a => a -> a -> a
+y
sb23
ab0123 :: y
ab0123 = y
sa0123y -> y -> y
forall a. C a => a -> a -> a
*y
sb0123 y -> y -> y
forall a. C a => a -> a -> a
- (y
ab02y -> y -> y
forall a. C a => a -> a -> a
+y
ab13)
d0 :: y
d0 = y
ab13 y -> y -> y
forall a. C a => a -> a -> a
+ y
c0
d1 :: y
d1 = y
c1
d2 :: y
d2 = y
ab02 y -> y -> y
forall a. C a => a -> a -> a
- y
c0
d3 :: y
d3 = y
ab0123 y -> y -> y
forall a. C a => a -> a -> a
- y
c1
in ((y
sa0123, y
sb0123), (y
d0, y
d1, y
d2, y
d3))