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 =
forall acc x. (acc -> x -> acc) -> acc -> T x -> acc
Sig.foldL forall y (sig :: * -> *).
(C y, Transform sig y) =>
sig y -> sig y -> sig y
SigG.mix (forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> Int -> y -> sig y
SigG.replicate LazySize
chunkSize Int
n forall a. C a => a
zero) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
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 =
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 -> forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
y -> sig y -> sig y
SigG.cons y
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 =
forall acc x. (acc -> x -> acc) -> acc -> T x -> acc
Sig.foldL forall y (sig :: * -> *).
(C y, Transform sig y) =>
sig y -> sig y -> sig y
SigG.mix forall sig. Monoid sig => sig
CutG.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
.
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 =
forall (sig :: * -> *) yv.
(Transform sig yv, C yv) =>
Int -> sig yv -> sig yv
reperiodize (forall sig. Read sig => sig -> Int
CutG.length sig y
x) forall a b. (a -> b) -> a -> b
$
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 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 =
forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
sig a -> T b -> sig b
SigG.takeStateMatch sig y
y forall a b. (a -> b) -> a -> b
$
forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState forall a b. (a -> b) -> a -> b
$
forall (sig :: * -> *) a.
Transform sig a =>
(sig a -> a) -> sig a -> sig a
SigG.mapTails
(forall y (sig :: * -> *). (C y, Read sig y) => sig y -> sig y -> y
AnaG.scalarProduct sig y
x)
(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 =
forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
sig a -> T b -> sig b
SigG.takeStateMatch sig y
y forall a b. (a -> b) -> a -> b
$
forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState forall a b. (a -> b) -> a -> b
$
forall (sig :: * -> *) a.
Transform sig a =>
(sig a -> a) -> sig a -> sig a
SigG.mapTails
(forall y (sig :: * -> *). (C y, Read sig y) => sig y -> sig y -> y
AnaG.scalarProduct (forall sig. Transform sig => sig -> sig
SigG.reverse sig y
x))
(forall (sig :: * -> *) y. Transform sig y => sig y -> sig y
SigG.laxTail forall a b. (a -> b) -> a -> b
$ 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 =
forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ 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
a0forall a. C a => a -> a -> a
+y
a1
sb01 :: y
sb01 = y
b0forall a. C a => a -> a -> a
+y
b1
ab0ab1 :: y
ab0ab1 = y
a0forall a. C a => a -> a -> a
*y
b0forall a. C a => a -> a -> a
+y
a1forall a. C a => a -> a -> a
*y
b1
in ((y
sa01, y
sb01), (y
ab0ab1, y
sa01forall a. C a => a -> a -> a
*y
sb01forall 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 =
forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ 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
a0forall a. C a => a -> a -> a
*y
b0
dab12 :: y
dab12 = y
a1forall a. C a => a -> a -> a
*y
b1 forall a. C a => a -> a -> a
- y
a2forall a. C a => a -> a -> a
*y
b2
sa01 :: y
sa01 = y
a0forall a. C a => a -> a -> a
+y
a1; sb01 :: y
sb01 = y
b0forall a. C a => a -> a -> a
+y
b1; tab01 :: y
tab01 = y
sa01forall a. C a => a -> a -> a
*y
sb01 forall a. C a => a -> a -> a
- y
ab0
sa02 :: y
sa02 = y
a0forall a. C a => a -> a -> a
+y
a2; sb02 :: y
sb02 = y
b0forall a. C a => a -> a -> a
+y
b2; tab02 :: y
tab02 = y
sa02forall a. C a => a -> a -> a
*y
sb02 forall a. C a => a -> a -> a
- y
ab0
sa012 :: y
sa012 = y
sa01forall a. C a => a -> a -> a
+y
a2
sb012 :: y
sb012 = y
sb01forall a. C a => a -> a -> a
+y
b2
d0 :: y
d0 = y
sa012forall a. C a => a -> a -> a
*y
sb012 forall a. C a => a -> a -> a
- y
tab01 forall a. C a => a -> a -> a
- y
tab02
d1 :: y
d1 = y
tab01 forall a. C a => a -> a -> a
- y
dab12
d2 :: y
d2 = y
tab02 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
a0forall a. C a => a -> a -> a
*y
b0
ab1 :: y
ab1 = y
a1forall a. C a => a -> a -> a
*y
b1
ab2 :: y
ab2 = y
a2forall a. C a => a -> a -> a
*y
b2
sa01 :: y
sa01 = y
a0forall a. C a => a -> a -> a
+y
a1; sb01 :: y
sb01 = y
b0forall a. C a => a -> a -> a
+y
b1
ab01 :: y
ab01 = y
sa01forall a. C a => a -> a -> a
*y
sb01 forall a. C a => a -> a -> a
- (y
ab0forall a. C a => a -> a -> a
+y
ab1)
sa02 :: y
sa02 = y
a0forall a. C a => a -> a -> a
+y
a2; sb02 :: y
sb02 = y
b0forall a. C a => a -> a -> a
+y
b2
ab02 :: y
ab02 = y
sa02forall a. C a => a -> a -> a
*y
sb02 forall a. C a => a -> a -> a
- (y
ab0forall a. C a => a -> a -> a
+y
ab2)
sa12 :: y
sa12 = y
a1forall a. C a => a -> a -> a
+y
a2; sb12 :: y
sb12 = y
b1forall a. C a => a -> a -> a
+y
b2
ab12 :: y
ab12 = y
sa12forall a. C a => a -> a -> a
*y
sb12 forall a. C a => a -> a -> a
- (y
ab1forall a. C a => a -> a -> a
+y
ab2)
in ((y
sa01forall a. C a => a -> a -> a
+y
a2, y
sb01forall a. C a => a -> a -> a
+y
b2), (y
ab0forall a. C a => a -> a -> a
+y
ab12, y
ab2forall a. C a => a -> a -> a
+y
ab01, y
ab1forall 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 =
forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ 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
a0forall a. C a => a -> a -> a
*y
b0
ab1 :: y
ab1 = y
a1forall a. C a => a -> a -> a
*y
b1
sa01 :: y
sa01 = y
a0forall a. C a => a -> a -> a
+y
a1; sb01 :: y
sb01 = y
b0forall a. C a => a -> a -> a
+y
b1
ab01 :: y
ab01 = y
sa01forall a. C a => a -> a -> a
*y
sb01 forall a. C a => a -> a -> a
- (y
ab0forall a. C a => a -> a -> a
+y
ab1)
ab2 :: y
ab2 = y
a2forall a. C a => a -> a -> a
*y
b2
ab3 :: y
ab3 = y
a3forall a. C a => a -> a -> a
*y
b3
sa23 :: y
sa23 = y
a2forall a. C a => a -> a -> a
+y
a3; sb23 :: y
sb23 = y
b2forall a. C a => a -> a -> a
+y
b3
ab23 :: y
ab23 = y
sa23forall a. C a => a -> a -> a
*y
sb23 forall a. C a => a -> a -> a
- (y
ab2forall a. C a => a -> a -> a
+y
ab3)
c0 :: y
c0 = y
ab0 forall a. C a => a -> a -> a
+ y
ab2 forall a. C a => a -> a -> a
- (y
ab1 forall a. C a => a -> a -> a
+ y
ab3)
c1 :: y
c1 = y
ab01 forall a. C a => a -> a -> a
+ y
ab23
ab02 :: y
ab02 = (y
a0forall a. C a => a -> a -> a
+y
a2)forall a. C a => a -> a -> a
*(y
b0forall a. C a => a -> a -> a
+y
b2)
ab13 :: y
ab13 = (y
a1forall a. C a => a -> a -> a
+y
a3)forall a. C a => a -> a -> a
*(y
b1forall a. C a => a -> a -> a
+y
b3)
sa0123 :: y
sa0123 = y
sa01forall a. C a => a -> a -> a
+y
sa23
sb0123 :: y
sb0123 = y
sb01forall a. C a => a -> a -> a
+y
sb23
ab0123 :: y
ab0123 = y
sa0123forall a. C a => a -> a -> a
*y
sb0123 forall a. C a => a -> a -> a
- (y
ab02forall a. C a => a -> a -> a
+y
ab13)
d0 :: y
d0 = y
ab13 forall a. C a => a -> a -> a
+ y
c0
d1 :: y
d1 = y
c1
d2 :: y
d2 = y
ab02 forall a. C a => a -> a -> a
- y
c0
d3 :: y
d3 = y
ab0123 forall a. C a => a -> a -> a
- y
c1
in ((y
sa0123, y
sb0123), (y
d0, y
d1, y
d2, y
d3))