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 =
   {- almost Sig.sum -}
   (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


{- |
It must hold @n <= CutG.length x@.
-}
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.sum -}
   (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

{- |
length of the input signals must be equal
-}
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



{- |
The size of both input signals must be equal.

Could be optimized by computing only first (length x) elements.
-}
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)


{-
Some small size convolutions using the Karatsuba trick.
We do not use Toom-3 multiplication,
because this requires division by 2 and 6.

In principle we could implement them
by calling the corresponding functions in Filter.NonRecursive
and periodize them afterwards.
However the custom implementations below
allow a litte bit more optimization,
namely sharing of some sums.
-}

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))