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


{- |
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 -}
   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

{- |
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 =
   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



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


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