{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
module Synthesizer.Generic.Filter.NonRecursive (
negate,
amplify,
amplifyVector,
normalize,
envelope,
envelopeVector,
fadeInOut,
delay,
delayPad,
delayPos,
delayNeg,
delayLazySize,
delayPadLazySize,
delayPosLazySize,
binomialMask,
binomial,
binomial1,
sums,
sumsDownsample2,
downsample2,
downsample,
sumRange,
pyramid,
sumRangeFromPyramid,
sumsPosModulated,
sumsPosModulatedPyramid,
movingAverageModulatedPyramid,
inverseFrequencyModulationFloor,
differentiate,
differentiateCenter,
differentiate2,
generic,
karatsubaFinite,
karatsubaFiniteInfinite,
karatsubaInfinite,
Pair,
convolvePair,
sumAndConvolvePair,
Triple,
convolvePairTriple,
convolveTriple,
sumAndConvolveTriple,
sumAndConvolveTripleAlt,
Quadruple,
convolveQuadruple,
sumAndConvolveQuadruple,
sumAndConvolveQuadrupleAlt,
maybeAccumulateRangeFromPyramid,
accumulatePosModulatedFromPyramid,
withPaddedInput,
addShiftedSimple,
consumeRangeFromPyramid,
sumRangeFromPyramidReverse,
sumRangeFromPyramidFoldr,
) where
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Generic.Cut as CutG
import qualified Synthesizer.Generic.Control as Ctrl
import qualified Synthesizer.Generic.LengthSignal as SigL
import qualified Synthesizer.Basic.Filter.NonRecursive as Filt
import qualified Synthesizer.State.Filter.NonRecursive as FiltS
import qualified Synthesizer.State.Signal as SigS
import Control.Monad (mplus, )
import Data.Function.HT (nest, )
import Data.Tuple.HT (mapSnd, mapPair, )
import Data.Maybe.HT (toMaybe, )
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Module as Module
import qualified Algebra.RealField as RealField
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import qualified NumericPrelude.Numeric as NP
import NumericPrelude.Numeric hiding (negate, )
import NumericPrelude.Base
{-# INLINE negate #-}
negate ::
(Additive.C a, SigG.Transform sig a) =>
sig a -> sig a
negate :: forall a (sig :: * -> *). (C a, Transform sig a) => sig a -> sig a
negate = forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map forall a. C a => a -> a
Additive.negate
{-# INLINE amplify #-}
amplify ::
(Ring.C a, SigG.Transform sig a) =>
a -> sig a -> sig a
amplify :: forall a (sig :: * -> *).
(C a, Transform sig a) =>
a -> sig a -> sig a
amplify a
v = forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map (a
vforall a. C a => a -> a -> a
*)
{-# INLINE amplifyVector #-}
amplifyVector ::
(Module.C a v, SigG.Transform sig v) =>
a -> sig v -> sig v
amplifyVector :: forall a v (sig :: * -> *).
(C a v, Transform sig v) =>
a -> sig v -> sig v
amplifyVector a
v = forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map (a
vforall a v. C a v => a -> v -> v
*>)
{-# INLINE normalize #-}
normalize ::
(Field.C a, SigG.Transform sig a) =>
(sig a -> a) -> sig a -> sig a
normalize :: forall a (sig :: * -> *).
(C a, Transform sig a) =>
(sig a -> a) -> sig a -> sig a
normalize sig a -> a
volume sig a
xs =
forall a (sig :: * -> *).
(C a, Transform sig a) =>
a -> sig a -> sig a
amplify (forall a. C a => a -> a
recip forall a b. (a -> b) -> a -> b
$ sig a -> a
volume sig a
xs) sig a
xs
{-# INLINE envelope #-}
envelope ::
(Ring.C a, SigG.Transform sig a) =>
sig a
-> sig a
-> sig a
envelope :: forall a (sig :: * -> *).
(C a, Transform sig a) =>
sig a -> sig a -> sig a
envelope = forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
(a -> b -> c) -> sig a -> sig b -> sig c
SigG.zipWith forall a. C a => a -> a -> a
(*)
{-# INLINE envelopeVector #-}
envelopeVector ::
(Module.C a v, SigG.Read sig a, SigG.Transform sig v) =>
sig a
-> sig v
-> sig v
envelopeVector :: forall a v (sig :: * -> *).
(C a v, Read sig a, Transform sig v) =>
sig a -> sig v -> sig v
envelopeVector = forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
(a -> b -> c) -> sig a -> sig b -> sig c
SigG.zipWith forall a v. C a v => a -> v -> v
(*>)
{-# INLINE fadeInOut #-}
fadeInOut ::
(Field.C a, SigG.Write sig a) =>
Int -> Int -> Int -> sig a -> sig a
fadeInOut :: forall a (sig :: * -> *).
(C a, Write sig a) =>
Int -> Int -> Int -> sig a -> sig a
fadeInOut Int
tIn Int
tHold Int
tOut sig a
xs =
let slopeIn :: a
slopeIn = forall a. C a => a -> a
recip (forall a b. (C a, C b) => a -> b
fromIntegral Int
tIn)
slopeOut :: a
slopeOut = forall a. C a => a -> a
Additive.negate (forall a. C a => a -> a
recip (forall a b. (C a, C b) => a -> b
fromIntegral Int
tOut))
leadIn :: sig a
leadIn = forall sig. Transform sig => Int -> sig -> sig
SigG.take Int
tIn forall a b. (a -> b) -> a -> b
$ forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.linear LazySize
SigG.defaultLazySize a
slopeIn a
0
leadOut :: sig a
leadOut = forall sig. Transform sig => Int -> sig -> sig
SigG.take Int
tOut forall a b. (a -> b) -> a -> b
$ forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.linear LazySize
SigG.defaultLazySize a
slopeOut a
1
(sig a
partIn, sig a
partHoldOut) = forall sig. Transform sig => Int -> sig -> (sig, sig)
SigG.splitAt Int
tIn sig a
xs
(sig a
partHold, sig a
partOut) = forall sig. Transform sig => Int -> sig -> (sig, sig)
SigG.splitAt Int
tHold sig a
partHoldOut
in forall a (sig :: * -> *).
(C a, Transform sig a) =>
sig a -> sig a -> sig a
envelope sig a
leadIn sig a
partIn forall sig. Monoid sig => sig -> sig -> sig
`SigG.append`
sig a
partHold forall sig. Monoid sig => sig -> sig -> sig
`SigG.append`
forall a (sig :: * -> *).
(C a, Transform sig a) =>
sig a -> sig a -> sig a
envelope sig a
leadOut sig a
partOut
{-# INLINE delay #-}
delay :: (Additive.C y, SigG.Write sig y) =>
Int -> sig y -> sig y
delay :: forall y (sig :: * -> *).
(C y, Write sig y) =>
Int -> sig y -> sig y
delay =
forall (sig :: * -> *) y. Write sig y => y -> Int -> sig y -> sig y
delayPad forall a. C a => a
zero
{-# INLINE delayPad #-}
delayPad :: (SigG.Write sig y) =>
y -> Int -> sig y -> sig y
delayPad :: forall (sig :: * -> *) y. Write sig y => y -> Int -> sig y -> sig y
delayPad y
z Int
n =
if Int
nforall a. Ord a => a -> a -> Bool
<Int
0
then forall sig. Transform sig => Int -> sig -> sig
SigG.drop (forall a. C a => a -> a
Additive.negate Int
n)
else forall sig. Monoid sig => sig -> sig -> sig
SigG.append (forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> Int -> y -> sig y
SigG.replicate LazySize
SigG.defaultLazySize Int
n y
z)
{-# INLINE delayPos #-}
delayPos :: (Additive.C y, SigG.Write sig y) =>
Int -> sig y -> sig y
delayPos :: forall y (sig :: * -> *).
(C y, Write sig y) =>
Int -> sig y -> sig y
delayPos Int
n =
forall sig. Monoid sig => sig -> sig -> sig
SigG.append (forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> Int -> y -> sig y
SigG.replicate LazySize
SigG.defaultLazySize Int
n forall a. C a => a
zero)
{-# INLINE delayNeg #-}
delayNeg :: (SigG.Transform sig y) =>
Int -> sig y -> sig y
delayNeg :: forall (sig :: * -> *) y. Transform sig y => Int -> sig y -> sig y
delayNeg = forall sig. Transform sig => Int -> sig -> sig
SigG.drop
{-# INLINE delayLazySize #-}
delayLazySize :: (Additive.C y, SigG.Write sig y) =>
SigG.LazySize -> Int -> sig y -> sig y
delayLazySize :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> Int -> sig y -> sig y
delayLazySize LazySize
size =
forall (sig :: * -> *) y.
Write sig y =>
LazySize -> y -> Int -> sig y -> sig y
delayPadLazySize LazySize
size forall a. C a => a
zero
{-# INLINE delayPadLazySize #-}
delayPadLazySize :: (SigG.Write sig y) =>
SigG.LazySize -> y -> Int -> sig y -> sig y
delayPadLazySize :: forall (sig :: * -> *) y.
Write sig y =>
LazySize -> y -> Int -> sig y -> sig y
delayPadLazySize LazySize
size y
z Int
n =
if Int
nforall a. Ord a => a -> a -> Bool
<Int
0
then forall sig. Transform sig => Int -> sig -> sig
SigG.drop (forall a. C a => a -> a
Additive.negate Int
n)
else forall sig. Monoid sig => sig -> sig -> sig
SigG.append (forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> Int -> y -> sig y
SigG.replicate LazySize
size Int
n y
z)
{-# INLINE delayPosLazySize #-}
delayPosLazySize :: (Additive.C y, SigG.Write sig y) =>
SigG.LazySize -> Int -> sig y -> sig y
delayPosLazySize :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> Int -> sig y -> sig y
delayPosLazySize LazySize
size Int
n =
forall sig. Monoid sig => sig -> sig -> sig
SigG.append (forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> Int -> y -> sig y
SigG.replicate LazySize
size Int
n forall a. C a => a
zero)
binomialMask ::
(Field.C a, SigG.Write sig a) =>
SigG.LazySize ->
Int -> sig a
binomialMask :: forall a (sig :: * -> *).
(C a, Write sig a) =>
LazySize -> Int -> sig a
binomialMask LazySize
size Int
n =
forall (sig :: * -> *) y s.
(Write0 sig, Storage (sig y)) =>
LazySize -> (s -> Maybe (y, s)) -> s -> sig y
SigG.unfoldR LazySize
size
(\(a
x, Integer
a, Integer
b) ->
forall a. Bool -> a -> Maybe a
toMaybe (Integer
bforall a. Ord a => a -> a -> Bool
>=Integer
0)
(a
x, (a
x forall a. C a => a -> a -> a
* forall a. C a => Integer -> a
fromInteger Integer
b forall a. C a => a -> a -> a
/ forall a. C a => Integer -> a
fromInteger (Integer
aforall a. C a => a -> a -> a
+Integer
1), Integer
aforall a. C a => a -> a -> a
+Integer
1, Integer
bforall a. C a => a -> a -> a
-Integer
1)))
(forall a. C a => a -> a
recip forall a b. (a -> b) -> a -> b
$ a
2 forall a. C a => a -> Integer -> a
^ forall a b. (C a, C b) => a -> b
fromIntegral Int
n, Integer
0, forall a b. (C a, C b) => a -> b
fromIntegral Int
n)
{-# INLINE binomial #-}
binomial ::
(Trans.C a, RealField.C a, Module.C a v, SigG.Transform sig v) =>
a -> a -> sig v -> sig v
binomial :: forall a v (sig :: * -> *).
(C a, C a, C a v, Transform sig v) =>
a -> a -> sig v -> sig v
binomial a
ratio a
freq =
let width :: Int
width = forall a b. (C a, C b) => a -> b
ceiling (a
2 forall a. C a => a -> a -> a
* forall a. C a => a -> a -> a
Filt.ratioFreqToVariance a
ratio a
freq forall a. C a => a -> Integer -> a
^ Integer
2)
in forall sig. Transform sig => Int -> sig -> sig
SigG.drop Int
width forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Int -> (a -> a) -> a -> a
nest (Int
2forall a. C a => a -> a -> a
*Int
width) (forall a v (sig :: * -> *).
(C a v, Transform sig v) =>
a -> sig v -> sig v
amplifyVector (forall a. a -> a -> a
asTypeOf a
0.5 a
freq) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (sig :: * -> *). (C a, Transform sig a) => sig a -> sig a
binomial1)
{-# INLINE binomial1 #-}
binomial1 ::
(Additive.C v, SigG.Transform sig v) => sig v -> sig v
binomial1 :: forall a (sig :: * -> *). (C a, Transform sig a) => sig a -> sig a
binomial1 = forall (sig :: * -> *) a.
(Read sig a, Transform sig a) =>
(a -> a -> a) -> sig a -> sig a
SigG.mapAdjacent forall a. C a => a -> a -> a
(+)
{-# INLINE sums #-}
sums ::
(Additive.C v, SigG.Transform sig v) =>
Int -> sig v -> sig v
sums :: forall v (sig :: * -> *).
(C v, Transform sig v) =>
Int -> sig v -> sig v
sums Int
n = forall (sig :: * -> *) a.
Transform sig a =>
(sig a -> a) -> sig a -> sig a
SigG.mapTails (forall a (sig :: * -> *). (C a, Read sig a) => sig a -> a
SigG.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sig. Transform sig => Int -> sig -> sig
SigG.take Int
n)
sumsDownsample2 ::
(Additive.C v, SigG.Write sig v) =>
SigG.LazySize -> sig v -> sig v
sumsDownsample2 :: forall v (sig :: * -> *).
(C v, Write sig v) =>
LazySize -> sig v -> sig v
sumsDownsample2 LazySize
cs =
forall (sig :: * -> *) y s.
(Write0 sig, Storage (sig y)) =>
LazySize -> (s -> Maybe (y, s)) -> s -> sig y
SigG.unfoldR LazySize
cs (\sig v
xs ->
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
SigG.viewL sig v
xs) forall a b. (a -> b) -> a -> b
$ \xxs0 :: (v, sig v)
xxs0@(v
x0,sig v
xs0) ->
forall (sig :: * -> *) y a.
Transform sig y =>
a -> (y -> sig y -> a) -> sig y -> a
SigG.switchL (v, sig v)
xxs0
(\ v
x1 sig v
xs1 -> (v
x0forall a. C a => a -> a -> a
+v
x1, sig v
xs1))
sig v
xs0)
downsample2 ::
(SigG.Write sig v) =>
SigG.LazySize -> sig v -> sig v
downsample2 :: forall (sig :: * -> *) v. Write sig v => LazySize -> sig v -> sig v
downsample2 LazySize
cs =
forall (sig :: * -> *) y s.
(Write0 sig, Storage (sig y)) =>
LazySize -> (s -> Maybe (y, s)) -> s -> sig y
SigG.unfoldR LazySize
cs
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd forall (sig :: * -> *) y. Transform sig y => sig y -> sig y
SigG.laxTail) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
SigG.viewL)
downsample ::
(SigG.Write sig v) =>
SigG.LazySize -> Int -> sig v -> sig v
downsample :: forall (sig :: * -> *) v.
Write sig v =>
LazySize -> Int -> sig v -> sig v
downsample LazySize
cs Int
n =
forall (sig :: * -> *) y s.
(Write0 sig, Storage (sig y)) =>
LazySize -> (s -> Maybe (y, s)) -> s -> sig y
SigG.unfoldR LazySize
cs
(\sig v
xs -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a b. a -> b -> a
const (forall sig. Transform sig => Int -> sig -> sig
SigG.drop Int
n sig v
xs))) forall a b. (a -> b) -> a -> b
$ forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
SigG.viewL sig v
xs)
sumRange ::
(Additive.C v, SigG.Transform sig v) =>
sig v -> (Int,Int) -> v
sumRange :: forall v (sig :: * -> *).
(C v, Transform sig v) =>
sig v -> (Int, Int) -> v
sumRange =
forall v source.
C v =>
((Int, Int) -> source -> v) -> source -> (Int, Int) -> v
Filt.sumRangePrepare forall a b. (a -> b) -> a -> b
$ \ (Int
l,Int
r) ->
forall a (sig :: * -> *). (C a, Read sig a) => sig a -> a
SigG.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sig. Transform sig => Int -> sig -> sig
SigG.take (Int
rforall a. C a => a -> a -> a
-Int
l) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sig. Transform sig => Int -> sig -> sig
SigG.drop Int
l
pyramid ::
(Additive.C v, SigG.Write sig v) =>
Int -> sig v -> ([Int], [sig v])
pyramid :: forall v (sig :: * -> *).
(C v, Write sig v) =>
Int -> sig v -> ([Int], [sig v])
pyramid Int
height sig v
sig =
let sizes :: [Int]
sizes = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (Int
1forall a. C a => a -> a -> a
+Int
height) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (Int
2forall a. C a => a -> a -> a
*) Int
1
in ([Int]
sizes,
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall v (sig :: * -> *).
(C v, Write sig v) =>
LazySize -> sig v -> sig v
sumsDownsample2) sig v
sig (forall a b. (a -> b) -> [a] -> [b]
map Int -> LazySize
SigG.LazySize forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail [Int]
sizes))
{-# INLINE sumRangeFromPyramid #-}
sumRangeFromPyramid ::
(Additive.C v, SigG.Transform sig v) =>
[sig v] -> (Int,Int) -> v
sumRangeFromPyramid :: forall v (sig :: * -> *).
(C v, Transform sig v) =>
[sig v] -> (Int, Int) -> v
sumRangeFromPyramid =
forall v source.
C v =>
((Int, Int) -> source -> v) -> source -> (Int, Int) -> v
Filt.sumRangePrepare forall a b. (a -> b) -> a -> b
$ \(Int, Int)
lr0 [sig v]
pyr0 ->
forall (sig :: * -> *) v a.
Transform sig v =>
(v -> a -> a) -> a -> [sig v] -> (Int, Int) -> a
consumeRangeFromPyramid (\v
v v -> v
k v
s -> v -> v
k (v
sforall a. C a => a -> a -> a
+v
v)) forall a. a -> a
id [sig v]
pyr0 (Int, Int)
lr0 forall a. C a => a
zero
sumRangeFromPyramidReverse ::
(Additive.C v, SigG.Transform sig v) =>
[sig v] -> (Int,Int) -> v
sumRangeFromPyramidReverse :: forall v (sig :: * -> *).
(C v, Transform sig v) =>
[sig v] -> (Int, Int) -> v
sumRangeFromPyramidReverse =
forall v source.
C v =>
((Int, Int) -> source -> v) -> source -> (Int, Int) -> v
Filt.sumRangePrepare forall a b. (a -> b) -> a -> b
$ \(Int, Int)
lr0 [sig v]
pyr0 ->
forall (sig :: * -> *) v a.
Transform sig v =>
(v -> a -> a) -> a -> [sig v] -> (Int, Int) -> a
consumeRangeFromPyramid forall a. C a => a -> a -> a
(+) forall a. C a => a
zero [sig v]
pyr0 (Int, Int)
lr0
sumRangeFromPyramidFoldr ::
(Additive.C v, SigG.Transform sig v) =>
[sig v] -> (Int,Int) -> v
sumRangeFromPyramidFoldr :: forall v (sig :: * -> *).
(C v, Transform sig v) =>
[sig v] -> (Int, Int) -> v
sumRangeFromPyramidFoldr =
forall v source.
C v =>
((Int, Int) -> source -> v) -> source -> (Int, Int) -> v
Filt.sumRangePrepare forall a b. (a -> b) -> a -> b
$ \(Int, Int)
lr0 [sig v]
pyr0 ->
case [sig v]
pyr0 of
[] -> forall a. HasCallStack => [Char] -> a
error [Char]
"empty pyramid"
(sig v
ps0:[sig v]
pss) ->
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\sig v
psNext (Int, Int) -> sig v -> v -> v
k (Int
l,Int
r) sig v
ps v
s ->
case Int
rforall a. C a => a -> a -> a
-Int
l of
Int
0 -> v
s
Int
1 -> v
s forall a. C a => a -> a -> a
+ forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> Int -> y
SigG.index sig v
ps Int
l
Int
_ ->
let (Int
lh,Int
ll) = forall a. C a => a -> a
NP.negate forall a b. (a -> b) -> a -> b
$ forall a. C a => a -> a -> (a, a)
divMod (forall a. C a => a -> a
NP.negate Int
l) Int
2
(Int
rh,Int
rl) = forall a. C a => a -> a -> (a, a)
divMod Int
r Int
2
{-# INLINE inc #-}
inc :: a -> a -> a -> a
inc a
b a
x = if a
bforall a. Eq a => a -> a -> Bool
==a
0 then forall a. a -> a
id else (a
xforall a. C a => a -> a -> a
+)
in (Int, Int) -> sig v -> v -> v
k (Int
lh,Int
rh) sig v
psNext forall a b. (a -> b) -> a -> b
$
forall {a} {a}. (Eq a, C a, C a) => a -> a -> a -> a
inc Int
ll (forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> Int -> y
SigG.index sig v
ps Int
l) forall a b. (a -> b) -> a -> b
$
forall {a} {a}. (Eq a, C a, C a) => a -> a -> a -> a
inc Int
rl (forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> Int -> y
SigG.index sig v
ps (Int
rforall a. C a => a -> a -> a
-Int
1)) forall a b. (a -> b) -> a -> b
$
v
s)
(\(Int
l,Int
r) sig v
ps v
s ->
v
s forall a. C a => a -> a -> a
+ (forall a (sig :: * -> *). (C a, Read sig a) => sig a -> a
SigG.sum forall a b. (a -> b) -> a -> b
$ forall sig. Transform sig => Int -> sig -> sig
SigG.take (Int
rforall a. C a => a -> a -> a
-Int
l) forall a b. (a -> b) -> a -> b
$ forall sig. Transform sig => Int -> sig -> sig
SigG.drop Int
l sig v
ps))
[sig v]
pss (Int, Int)
lr0 sig v
ps0 forall a. C a => a
zero
{-# INLINE maybeAccumulateRangeFromPyramid #-}
maybeAccumulateRangeFromPyramid ::
(SigG.Transform sig v) =>
(v -> v -> v) ->
[sig v] -> (Int,Int) -> Maybe v
maybeAccumulateRangeFromPyramid :: forall (sig :: * -> *) v.
Transform sig v =>
(v -> v -> v) -> [sig v] -> (Int, Int) -> Maybe v
maybeAccumulateRangeFromPyramid v -> v -> v
acc =
forall source v.
((Int, Int) -> source -> v) -> source -> (Int, Int) -> v
Filt.symmetricRangePrepare forall a b. (a -> b) -> a -> b
$ \(Int, Int)
lr0 [sig v]
pyr0 ->
forall (sig :: * -> *) v a.
Transform sig v =>
(v -> a -> a) -> a -> [sig v] -> (Int, Int) -> a
consumeRangeFromPyramid
(\v
v Maybe v -> Maybe v
k Maybe v
s -> Maybe v -> Maybe v
k (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v -> v -> v
acc v
v) Maybe v
s forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a. a -> Maybe a
Just v
v))
forall a. a -> a
id [sig v]
pyr0 (Int, Int)
lr0 forall a. Maybe a
Nothing
{-# INLINE consumeRangeFromPyramid #-}
consumeRangeFromPyramid ::
(SigG.Transform sig v) =>
(v -> a -> a) -> a ->
[sig v] -> (Int,Int) -> a
consumeRangeFromPyramid :: forall (sig :: * -> *) v a.
Transform sig v =>
(v -> a -> a) -> a -> [sig v] -> (Int, Int) -> a
consumeRangeFromPyramid v -> a -> a
acc a
init0 [sig v]
pyr0 (Int, Int)
lr0 =
case [sig v]
pyr0 of
[] -> forall a. HasCallStack => [Char] -> a
error [Char]
"empty pyramid"
(sig v
ps0:[sig v]
pss) ->
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\sig v
psNext (Int, Int) -> sig v -> a
k (Int
l,Int
r) sig v
ps ->
case Int
rforall a. C a => a -> a -> a
-Int
l of
Int
0 -> a
init0
Int
1 -> v -> a -> a
acc (forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> Int -> y
SigG.index sig v
ps Int
l) a
init0
Int
_ ->
let (Int
lh,Int
ll) = forall a. C a => a -> a
NP.negate forall a b. (a -> b) -> a -> b
$ forall a. C a => a -> a -> (a, a)
divMod (forall a. C a => a -> a
NP.negate Int
l) Int
2
(Int
rh,Int
rl) = forall a. C a => a -> a -> (a, a)
divMod Int
r Int
2
{-# INLINE inc #-}
inc :: a -> v -> a -> a
inc a
b v
x = if a
bforall a. Eq a => a -> a -> Bool
==a
0 then forall a. a -> a
id else v -> a -> a
acc v
x
in forall {a}. (Eq a, C a) => a -> v -> a -> a
inc Int
ll (forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> Int -> y
SigG.index sig v
ps Int
l) forall a b. (a -> b) -> a -> b
$
forall {a}. (Eq a, C a) => a -> v -> a -> a
inc Int
rl (forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> Int -> y
SigG.index sig v
ps (Int
rforall a. C a => a -> a -> a
-Int
1)) forall a b. (a -> b) -> a -> b
$
(Int, Int) -> sig v -> a
k (Int
lh,Int
rh) sig v
psNext)
(\(Int
l,Int
r) sig v
ps ->
forall (sig :: * -> *) y s.
(Read0 sig, Storage (sig y)) =>
(y -> s -> s) -> s -> sig y -> s
SigG.foldR v -> a -> a
acc a
init0 forall a b. (a -> b) -> a -> b
$
forall sig. Transform sig => Int -> sig -> sig
SigG.take (Int
rforall a. C a => a -> a -> a
-Int
l) forall a b. (a -> b) -> a -> b
$ forall sig. Transform sig => Int -> sig -> sig
SigG.drop Int
l sig v
ps)
[sig v]
pss (Int, Int)
lr0 sig v
ps0
sumsPosModulated ::
(Additive.C v, SigG.Transform sig (Int,Int), SigG.Transform sig v) =>
sig (Int,Int) -> sig v -> sig v
sumsPosModulated :: forall v (sig :: * -> *).
(C v, Transform sig (Int, Int), Transform sig v) =>
sig (Int, Int) -> sig v -> sig v
sumsPosModulated sig (Int, Int)
ctrl sig v
xs =
forall (sig :: * -> *) a b c.
(Transform sig a, Transform sig b, Transform sig c) =>
(a -> sig b -> c) -> sig a -> sig b -> sig c
SigG.zipWithTails (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall v (sig :: * -> *).
(C v, Transform sig v) =>
sig v -> (Int, Int) -> v
sumRange) sig (Int, Int)
ctrl sig v
xs
{-# INLINE accumulatePosModulatedFromPyramid #-}
accumulatePosModulatedFromPyramid ::
(SigG.Transform sig (Int,Int), SigG.Write sig v) =>
([sig v] -> (Int,Int) -> v) ->
([Int], [sig v]) ->
sig (Int,Int) -> sig v
accumulatePosModulatedFromPyramid :: forall (sig :: * -> *) v.
(Transform sig (Int, Int), Write sig v) =>
([sig v] -> (Int, Int) -> v)
-> ([Int], [sig v]) -> sig (Int, Int) -> sig v
accumulatePosModulatedFromPyramid [sig v] -> (Int, Int) -> v
accumulate ([Int]
sizes,[sig v]
pyr0) sig (Int, Int)
ctrl =
let blockSize :: Int
blockSize = forall a. [a] -> a
head [Int]
sizes
pyrStarts :: [[sig v]]
pyrStarts = forall a. (a -> a) -> a -> [a]
iterate (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall sig. Transform sig => Int -> sig -> sig
SigG.drop [Int]
sizes) [sig v]
pyr0
ctrlBlocks :: [sig (Int, Int)]
ctrlBlocks = forall y. T y -> [y]
SigS.toList forall a b. (a -> b) -> a -> b
$ forall sig. Transform sig => Int -> sig -> T sig
SigG.sliceVertical Int
blockSize sig (Int, Int)
ctrl
in forall sig. Monoid sig => [sig] -> sig
SigG.concat forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\[sig v]
pyr ->
forall (sig :: * -> *) y. Write sig y => LazySize -> T y -> sig y
SigG.fromState (Int -> LazySize
SigG.LazySize Int
blockSize) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> T a -> T b
SigS.map ([sig v] -> (Int, Int) -> v
accumulate [sig v]
pyr) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith (\Int
d -> forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ((Int
dforall a. C a => a -> a -> a
+), (Int
dforall a. C a => a -> a -> a
+))) (forall a. (a -> a) -> a -> T a
SigS.iterate (Int
1forall a. C a => a -> a -> a
+) Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState)
[[sig v]]
pyrStarts [sig (Int, Int)]
ctrlBlocks
sumsPosModulatedPyramid ::
(Additive.C v, SigG.Transform sig (Int,Int), SigG.Write sig v) =>
Int -> sig (Int,Int) -> sig v -> sig v
sumsPosModulatedPyramid :: forall v (sig :: * -> *).
(C v, Transform sig (Int, Int), Write sig v) =>
Int -> sig (Int, Int) -> sig v -> sig v
sumsPosModulatedPyramid Int
height sig (Int, Int)
ctrl sig v
xs =
forall (sig :: * -> *) v.
(Transform sig (Int, Int), Write sig v) =>
([sig v] -> (Int, Int) -> v)
-> ([Int], [sig v]) -> sig (Int, Int) -> sig v
accumulatePosModulatedFromPyramid
forall v (sig :: * -> *).
(C v, Transform sig v) =>
[sig v] -> (Int, Int) -> v
sumRangeFromPyramid
(forall v (sig :: * -> *).
(C v, Write sig v) =>
Int -> sig v -> ([Int], [sig v])
pyramid Int
height sig v
xs) sig (Int, Int)
ctrl
withPaddedInput ::
(SigG.Transform sig Int, SigG.Transform sig (Int, Int),
SigG.Write sig y) =>
y -> (sig (Int, Int) -> sig y -> v) ->
Int ->
sig Int ->
sig y -> v
withPaddedInput :: forall (sig :: * -> *) y v.
(Transform sig Int, Transform sig (Int, Int), Write sig y) =>
y -> (sig (Int, Int) -> sig y -> v) -> Int -> sig Int -> sig y -> v
withPaddedInput y
pad sig (Int, Int) -> sig y -> v
proc Int
maxC sig Int
ctrl sig y
xs =
sig (Int, Int) -> sig y -> v
proc
(forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map (\Int
c -> (Int
maxC forall a. C a => a -> a -> a
- Int
c, Int
maxC forall a. C a => a -> a -> a
+ Int
c forall a. C a => a -> a -> a
+ Int
1)) sig Int
ctrl)
(forall (sig :: * -> *) y. Write sig y => y -> Int -> sig y -> sig y
delayPad y
pad Int
maxC sig y
xs)
movingAverageModulatedPyramid ::
(Field.C a, Module.C a v,
SigG.Transform sig Int, SigG.Transform sig (Int,Int), SigG.Write sig v) =>
a -> Int -> Int -> sig Int -> sig v -> sig v
movingAverageModulatedPyramid :: forall a v (sig :: * -> *).
(C a, C a v, Transform sig Int, Transform sig (Int, Int),
Write sig v) =>
a -> Int -> Int -> sig Int -> sig v -> sig v
movingAverageModulatedPyramid a
amp Int
height Int
maxC sig Int
ctrl0 =
forall (sig :: * -> *) y v.
(Transform sig Int, Transform sig (Int, Int), Write sig y) =>
y -> (sig (Int, Int) -> sig y -> v) -> Int -> sig Int -> sig y -> v
withPaddedInput forall a. C a => a
zero
(\sig (Int, Int)
ctrl sig v
xs ->
forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
(a -> b -> c) -> sig a -> sig b -> sig c
SigG.zipWith (\Int
c v
x -> (a
amp forall a. C a => a -> a -> a
/ forall a b. (C a, C b) => a -> b
fromIntegral (Int
2forall a. C a => a -> a -> a
*Int
cforall a. C a => a -> a -> a
+Int
1)) forall a v. C a v => a -> v -> v
*> v
x) sig Int
ctrl0 forall a b. (a -> b) -> a -> b
$
forall v (sig :: * -> *).
(C v, Transform sig (Int, Int), Write sig v) =>
Int -> sig (Int, Int) -> sig v -> sig v
sumsPosModulatedPyramid Int
height sig (Int, Int)
ctrl sig v
xs)
Int
maxC sig Int
ctrl0
inverseFrequencyModulationFloor ::
(Ord t, Ring.C t, SigG.Write sig v, SigG.Read sig t) =>
SigG.LazySize ->
sig t -> sig v -> sig v
inverseFrequencyModulationFloor :: forall t (sig :: * -> *) v.
(Ord t, C t, Write sig v, Read sig t) =>
LazySize -> sig t -> sig v -> sig v
inverseFrequencyModulationFloor LazySize
chunkSize sig t
ctrl sig v
xs =
forall (sig :: * -> *) y. Write sig y => LazySize -> T y -> sig y
SigG.fromState LazySize
chunkSize
(forall t v. (Ord t, C t) => T t -> T v -> T v
FiltS.inverseFrequencyModulationFloor
(forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState sig t
ctrl) (forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState sig v
xs))
{-# INLINE differentiate #-}
differentiate ::
(Additive.C v, SigG.Transform sig v) =>
sig v -> sig v
differentiate :: forall a (sig :: * -> *). (C a, Transform sig a) => sig a -> sig a
differentiate sig v
x = forall (sig :: * -> *) a.
(Read sig a, Transform sig a) =>
(a -> a -> a) -> sig a -> sig a
SigG.mapAdjacent forall a. C a => a -> a -> a
subtract sig v
x
{-# INLINE differentiateCenter #-}
differentiateCenter ::
(Field.C v, SigG.Transform sig v) =>
sig v -> sig v
differentiateCenter :: forall v (sig :: * -> *). (C v, Transform sig v) => sig v -> sig v
differentiateCenter =
forall sig. Transform sig => Int -> sig -> sig
SigG.drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (sig :: * -> *) y0 y1 s.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
SigG.crochetL
(\v
x0 (v
x1,v
x2) -> forall a. a -> Maybe a
Just ((v
x2forall a. C a => a -> a -> a
-v
x0)forall a. C a => a -> a -> a
/v
2, (v
x0,v
x1)))
(forall a. C a => a
zero,forall a. C a => a
zero)
{-# INLINE differentiate2 #-}
differentiate2 ::
(Additive.C v, SigG.Transform sig v) =>
sig v -> sig v
differentiate2 :: forall a (sig :: * -> *). (C a, Transform sig a) => sig a -> sig a
differentiate2 = forall a (sig :: * -> *). (C a, Transform sig a) => sig a -> sig a
differentiate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (sig :: * -> *). (C a, Transform sig a) => sig a -> sig a
differentiate
{-# INLINE generic #-}
generic ::
(Module.C a v, SigG.Transform sig a, SigG.Write sig v) =>
sig a -> sig v -> sig v
generic :: forall a v (sig :: * -> *).
(C a v, Transform sig a, Write sig v) =>
sig a -> sig v -> sig v
generic sig a
m sig v
x =
if forall sig. Read sig => sig -> Bool
SigG.null sig a
m Bool -> Bool -> Bool
|| forall sig. Read sig => sig -> Bool
SigG.null sig v
x
then forall sig. Monoid sig => sig
CutG.empty
else
let mr :: sig a
mr = forall sig. Transform sig => sig -> sig
SigG.reverse sig a
m
xp :: sig v
xp = forall y (sig :: * -> *).
(C y, Write sig y) =>
Int -> sig y -> sig y
delayPos (forall a. Enum a => a -> a
pred (forall sig. Read sig => sig -> Int
SigG.length sig a
m)) sig v
x
in forall (sig :: * -> *) a.
Transform sig a =>
(sig a -> a) -> sig a -> sig a
SigG.mapTails (forall t y (sig :: * -> *).
(C t y, Read sig t, Read sig y) =>
sig t -> sig y -> y
SigG.linearComb sig a
mr) sig v
xp
karatsubaFinite ::
(Additive.C a, Additive.C b, Additive.C c,
SigG.Transform sig a, SigG.Transform sig b, SigG.Transform sig c) =>
(a -> b -> c) ->
sig a -> sig b -> sig c
karatsubaFinite :: 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
karatsubaFinite a -> b -> c
mul sig a
a sig b
b =
forall sig. T sig -> sig
SigL.toSignal 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) -> T (sig a) -> T (sig b) -> T (sig c)
karatsubaBounded a -> b -> c
mul
(forall sig. Read sig => sig -> T sig
SigL.fromSignal sig a
a) (forall sig. Read sig => sig -> T sig
SigL.fromSignal sig b
b)
{-# INLINE karatsubaBounded #-}
karatsubaBounded ::
(Additive.C a, Additive.C b, Additive.C c,
SigG.Transform sig a, SigG.Transform sig b, SigG.Transform sig c) =>
(a -> b -> c) ->
SigL.T (sig a) -> SigL.T (sig b) -> SigL.T (sig c)
karatsubaBounded :: forall a b c (sig :: * -> *).
(C a, C b, C c, Transform sig a, Transform sig b,
Transform sig c) =>
(a -> b -> c) -> T (sig a) -> T (sig b) -> T (sig c)
karatsubaBounded a -> b -> c
mul T (sig a)
a T (sig b)
b =
case (forall sig. T sig -> Int
SigL.length T (sig a)
a, forall sig. T sig -> Int
SigL.length T (sig b)
b) of
(Int
0,Int
_) -> forall sig. Monoid sig => sig
CutG.empty
(Int
_,Int
0) -> forall sig. Monoid sig => sig
CutG.empty
(Int
1,Int
_) ->
forall (sig :: * -> *) y a.
Transform sig y =>
a -> (y -> sig y -> a) -> sig y -> a
SigG.switchL
(forall a. HasCallStack => [Char] -> a
error [Char]
"karatsubaBounded: empty signal")
(\a
y sig a
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map (a -> b -> c
mul a
y)) T (sig b)
b) forall a b. (a -> b) -> a -> b
$
forall sig. T sig -> sig
SigL.body T (sig a)
a
(Int
_,Int
1) ->
forall (sig :: * -> *) y a.
Transform sig y =>
a -> (y -> sig y -> a) -> sig y -> a
SigG.switchL
(forall a. HasCallStack => [Char] -> a
error [Char]
"karatsubaBounded: empty signal")
(\b
y sig b
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map (forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> c
mul b
y)) T (sig a)
a) forall a b. (a -> b) -> a -> b
$
forall sig. T sig -> sig
SigL.body T (sig b)
b
(Int
2,Int
2) ->
let [a
a0,a
a1] = forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> [y]
SigG.toList (forall sig. T sig -> sig
SigL.toSignal T (sig a)
a)
[b
b0,b
b1] = forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> [y]
SigG.toList (forall sig. T sig -> sig
SigL.toSignal T (sig b)
b)
(c
c0,c
c1,c
c2) = forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Pair a -> Pair b -> Triple c
convolvePair a -> b -> c
mul (a
a0,a
a1) (b
b0,b
b1)
in forall sig. Int -> sig -> T sig
SigL.Cons Int
3 forall a b. (a -> b) -> a -> b
$ forall (sig1 :: * -> *) a b c (sig0 :: * -> *).
(Transform sig1 a, Transform sig1 b, Transform sig1 c,
Transform sig0 c) =>
T (sig1 a) -> T (sig1 b) -> sig0 c -> sig1 c
rechunk T (sig a)
a T (sig b)
b forall a b. (a -> b) -> a -> b
$
c
c0 forall a. a -> [a] -> [a]
: c
c1 forall a. a -> [a] -> [a]
: c
c2 forall a. a -> [a] -> [a]
: []
(Int
2,Int
3) ->
let [a
a0,a
a1] = forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> [y]
SigG.toList (forall sig. T sig -> sig
SigL.toSignal T (sig a)
a)
[b
b0,b
b1,b
b2] = forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> [y]
SigG.toList (forall sig. T sig -> sig
SigL.toSignal T (sig b)
b)
(c
c0,c
c1,c
c2,c
c3) =
forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Pair a -> Triple b -> (c, c, c, c)
convolvePairTriple a -> b -> c
mul (a
a0,a
a1) (b
b0,b
b1,b
b2)
in forall sig. Int -> sig -> T sig
SigL.Cons Int
4 forall a b. (a -> b) -> a -> b
$ forall (sig1 :: * -> *) a b c (sig0 :: * -> *).
(Transform sig1 a, Transform sig1 b, Transform sig1 c,
Transform sig0 c) =>
T (sig1 a) -> T (sig1 b) -> sig0 c -> sig1 c
rechunk T (sig a)
a T (sig b)
b forall a b. (a -> b) -> a -> b
$
c
c0 forall a. a -> [a] -> [a]
: c
c1 forall a. a -> [a] -> [a]
: c
c2 forall a. a -> [a] -> [a]
: c
c3 forall a. a -> [a] -> [a]
: []
(Int
3,Int
2) ->
let [a
a0,a
a1,a
a2] = forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> [y]
SigG.toList (forall sig. T sig -> sig
SigL.toSignal T (sig a)
a)
[b
b0,b
b1] = forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> [y]
SigG.toList (forall sig. T sig -> sig
SigL.toSignal T (sig b)
b)
(c
c0,c
c1,c
c2,c
c3) =
forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Pair a -> Triple b -> (c, c, c, c)
convolvePairTriple (forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> c
mul) (b
b0,b
b1) (a
a0,a
a1,a
a2)
in forall sig. Int -> sig -> T sig
SigL.Cons Int
4 forall a b. (a -> b) -> a -> b
$ forall (sig1 :: * -> *) a b c (sig0 :: * -> *).
(Transform sig1 a, Transform sig1 b, Transform sig1 c,
Transform sig0 c) =>
T (sig1 a) -> T (sig1 b) -> sig0 c -> sig1 c
rechunk T (sig a)
a T (sig b)
b forall a b. (a -> b) -> a -> b
$
c
c0 forall a. a -> [a] -> [a]
: c
c1 forall a. a -> [a] -> [a]
: c
c2 forall a. a -> [a] -> [a]
: c
c3 forall a. a -> [a] -> [a]
: []
(Int
3,Int
3) ->
let [a
a0,a
a1,a
a2] = forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> [y]
SigG.toList (forall sig. T sig -> sig
SigL.toSignal T (sig a)
a)
[b
b0,b
b1,b
b2] = forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> [y]
SigG.toList (forall sig. T sig -> sig
SigL.toSignal T (sig b)
b)
(c
c0,c
c1,c
c2,c
c3,c
c4) =
forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Triple a -> Triple b -> (c, c, c, c, c)
convolveTriple a -> b -> c
mul (a
a0,a
a1,a
a2) (b
b0,b
b1,b
b2)
in forall sig. Int -> sig -> T sig
SigL.Cons Int
5 forall a b. (a -> b) -> a -> b
$ forall (sig1 :: * -> *) a b c (sig0 :: * -> *).
(Transform sig1 a, Transform sig1 b, Transform sig1 c,
Transform sig0 c) =>
T (sig1 a) -> T (sig1 b) -> sig0 c -> sig1 c
rechunk T (sig a)
a T (sig b)
b forall a b. (a -> b) -> a -> b
$
c
c0 forall a. a -> [a] -> [a]
: c
c1 forall a. a -> [a] -> [a]
: c
c2 forall a. a -> [a] -> [a]
: c
c3 forall a. a -> [a] -> [a]
: c
c4 forall a. a -> [a] -> [a]
: []
(Int
4,Int
4) ->
let [a
a0,a
a1,a
a2,a
a3] = forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> [y]
SigG.toList (forall sig. T sig -> sig
SigL.toSignal T (sig a)
a)
[b
b0,b
b1,b
b2,b
b3] = forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> [y]
SigG.toList (forall sig. T sig -> sig
SigL.toSignal T (sig b)
b)
(c
c0,c
c1,c
c2,c
c3,c
c4,c
c5,c
c6) =
forall a b c.
(C a, C b, C c) =>
(a -> b -> c)
-> Quadruple a -> Quadruple b -> (c, c, c, c, c, c, c)
convolveQuadruple a -> b -> c
mul (a
a0,a
a1,a
a2,a
a3) (b
b0,b
b1,b
b2,b
b3)
in forall sig. Int -> sig -> T sig
SigL.Cons Int
7 forall a b. (a -> b) -> a -> b
$ forall (sig1 :: * -> *) a b c (sig0 :: * -> *).
(Transform sig1 a, Transform sig1 b, Transform sig1 c,
Transform sig0 c) =>
T (sig1 a) -> T (sig1 b) -> sig0 c -> sig1 c
rechunk T (sig a)
a T (sig b)
b forall a b. (a -> b) -> a -> b
$
c
c0 forall a. a -> [a] -> [a]
: c
c1 forall a. a -> [a] -> [a]
: c
c2 forall a. a -> [a] -> [a]
: c
c3 forall a. a -> [a] -> [a]
: c
c4 forall a. a -> [a] -> [a]
: c
c5 forall a. a -> [a] -> [a]
: c
c6 forall a. a -> [a] -> [a]
: []
(Int
lenA,Int
lenB) ->
let n2 :: Int
n2 = forall a. C a => a -> a -> a
div (forall a. Ord a => a -> a -> a
max Int
lenA Int
lenB) Int
2
(T (sig a)
a0,T (sig a)
a1) = forall sig. Transform sig => Int -> T sig -> (T sig, T sig)
SigL.splitAt Int
n2 T (sig a)
a
(T (sig b)
b0,T (sig b)
b1) = forall sig. Transform sig => Int -> T sig -> (T sig, T sig)
SigL.splitAt Int
n2 T (sig b)
b
(T (sig c)
c0,T (sig c)
c1,T (sig c)
c2) =
forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Pair a -> Pair b -> Triple c
convolvePair
(forall a b c (sig :: * -> *).
(C a, C b, C c, Transform sig a, Transform sig b,
Transform sig c) =>
(a -> b -> c) -> T (sig a) -> T (sig b) -> T (sig c)
karatsubaBounded a -> b -> c
mul)
(T (sig a)
a0,T (sig a)
a1) (T (sig b)
b0,T (sig b)
b1)
in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (sig1 :: * -> *) a b c (sig0 :: * -> *).
(Transform sig1 a, Transform sig1 b, Transform sig1 c,
Transform sig0 c) =>
T (sig1 a) -> T (sig1 b) -> sig0 c -> sig1 c
rechunk T (sig a)
a T (sig b)
b) forall a b. (a -> b) -> a -> b
$
forall a (sig :: * -> *).
(C a, Transform sig a) =>
Int -> T (sig a) -> T (sig a) -> T (sig a)
SigL.addShiftedSimple Int
n2 T (sig c)
c0 forall a b. (a -> b) -> a -> b
$
forall a (sig :: * -> *).
(C a, Transform sig a) =>
Int -> T (sig a) -> T (sig a) -> T (sig a)
SigL.addShiftedSimple Int
n2 T (sig c)
c1 T (sig c)
c2
{-# INLINE rechunk #-}
rechunk ::
(SigG.Transform sig1 a, SigG.Transform sig1 b, SigG.Transform sig1 c,
SigG.Transform sig0 c) =>
SigL.T (sig1 a) -> SigL.T (sig1 b) -> sig0 c -> sig1 c
rechunk :: forall (sig1 :: * -> *) a b c (sig0 :: * -> *).
(Transform sig1 a, Transform sig1 b, Transform sig1 c,
Transform sig0 c) =>
T (sig1 a) -> T (sig1 b) -> sig0 c -> sig1 c
rechunk T (sig1 a)
a T (sig1 b)
b sig0 c
c =
let (sig0 c
ac,sig0 c
bc) = forall sig. Transform sig => Int -> sig -> (sig, sig)
CutG.splitAt (forall sig. T sig -> Int
SigL.length T (sig1 a)
a) sig0 c
c
in forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
sig a -> T b -> sig b
SigG.takeStateMatch (forall sig. T sig -> sig
SigL.body T (sig1 a)
a) (forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState sig0 c
ac)
forall sig. Monoid sig => sig -> sig -> sig
`SigG.append`
forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
sig a -> T b -> sig b
SigG.takeStateMatch (forall sig. T sig -> sig
SigL.body T (sig1 b)
b) (forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState sig0 c
bc)
karatsubaFiniteInfinite ::
(Additive.C a, Additive.C b, Additive.C c,
SigG.Transform sig a, SigG.Transform sig b, SigG.Transform sig c) =>
(a -> b -> c) ->
sig a -> sig b -> sig c
karatsubaFiniteInfinite :: 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
karatsubaFiniteInfinite a -> b -> c
mul sig a
a sig b
b =
let al :: T (sig a)
al = forall sig. Read sig => sig -> T sig
SigL.fromSignal sig a
a
in case forall sig. T sig -> Int
SigL.length T (sig a)
al of
Int
0 -> forall sig. Monoid sig => sig
CutG.empty
Int
alen ->
forall x acc. (x -> acc -> acc) -> acc -> T x -> acc
SigS.foldR (forall a (sig :: * -> *).
(C a, Transform sig a) =>
Int -> sig a -> sig a -> sig a
addShiftedSimple Int
alen) forall sig. Monoid sig => sig
CutG.empty forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> T a -> T b
SigS.map forall sig. T sig -> sig
SigL.toSignal forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> T a -> T b
SigS.map (forall a b c (sig :: * -> *).
(C a, C b, C c, Transform sig a, Transform sig b,
Transform sig c) =>
(a -> b -> c) -> T (sig a) -> T (sig b) -> T (sig c)
karatsubaBounded a -> b -> c
mul T (sig a)
al forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sig. Read sig => sig -> T sig
SigL.fromSignal) forall a b. (a -> b) -> a -> b
$
forall sig. Transform sig => Int -> sig -> T sig
SigG.sliceVertical Int
alen sig b
b
karatsubaInfinite ::
(Additive.C a, Additive.C b, Additive.C c,
SigG.Transform sig a, SigG.Transform sig c, SigG.Transform sig b) =>
(a -> b -> c) ->
sig a -> sig b -> sig c
karatsubaInfinite :: forall a b c (sig :: * -> *).
(C a, C b, C c, Transform sig a, Transform sig c,
Transform sig b) =>
(a -> b -> c) -> sig a -> sig b -> sig c
karatsubaInfinite a -> b -> c
mul =
let recourse :: Int -> sig a -> sig b -> sig c
recourse Int
n sig a
a sig b
b =
let (sig a
a0,sig a
a1) = forall sig. Transform sig => Int -> sig -> (sig, sig)
SigG.splitAt Int
n sig a
a
(sig b
b0,sig b
b1) = forall sig. Transform sig => Int -> sig -> (sig, sig)
SigG.splitAt Int
n sig b
b
ab00 :: sig c
ab00 =
forall sig. T sig -> sig
SigL.toSignal 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) -> T (sig a) -> T (sig b) -> T (sig c)
karatsubaBounded a -> b -> c
mul
(forall sig. Read sig => sig -> T sig
SigL.fromSignal sig a
a0) (forall sig. Read sig => sig -> T sig
SigL.fromSignal sig b
b0)
ab01 :: sig c
ab01 = 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
karatsubaFiniteInfinite a -> b -> c
mul sig a
a0 sig b
b1
ab10 :: sig c
ab10 = 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
karatsubaFiniteInfinite (forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> c
mul) sig b
b0 sig a
a1
ab11 :: sig c
ab11 = Int -> sig a -> sig b -> sig c
recourse (Int
2forall a. C a => a -> a -> a
*Int
n) sig a
a1 sig b
b1
in if forall sig. Read sig => sig -> Bool
SigG.null sig a
a Bool -> Bool -> Bool
|| forall sig. Read sig => sig -> Bool
SigG.null sig b
b
then forall sig. Monoid sig => sig
CutG.empty
else
forall a (sig :: * -> *).
(C a, Transform sig a) =>
Int -> sig a -> sig a -> sig a
addShiftedSimple Int
n sig c
ab00 forall a b. (a -> b) -> a -> b
$
forall a (sig :: * -> *).
(C a, Transform sig a) =>
Int -> sig a -> sig a -> sig a
addShiftedSimple Int
n (forall y (sig :: * -> *).
(C y, Transform sig y) =>
sig y -> sig y -> sig y
SigG.mix sig c
ab01 sig c
ab10) sig c
ab11
in forall {sig :: * -> *}.
(Transform sig b, Transform sig a, Transform sig c) =>
Int -> sig a -> sig b -> sig c
recourse Int
1
{-# INLINE addShiftedSimple #-}
addShiftedSimple ::
(Additive.C a, SigG.Transform sig a) =>
Int -> sig a -> sig a -> sig a
addShiftedSimple :: forall a (sig :: * -> *).
(C a, Transform sig a) =>
Int -> sig a -> sig a -> sig a
addShiftedSimple Int
del sig a
a sig a
b =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall sig. Monoid sig => sig -> sig -> sig
CutG.append forall a b. (a -> b) -> a -> b
$
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall y (sig :: * -> *).
(C y, Transform sig y) =>
sig y -> sig y -> sig y
SigG.mix sig a
b) forall a b. (a -> b) -> a -> b
$
forall sig. Transform sig => Int -> sig -> (sig, sig)
CutG.splitAt Int
del sig a
a
type Pair a = (a,a)
{-# INLINE convolvePair #-}
convolvePair ::
(Additive.C a, Additive.C b, Additive.C c) =>
(a -> b -> c) ->
Pair a -> Pair b -> Triple c
convolvePair :: forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Pair a -> Pair b -> Triple c
convolvePair a -> b -> c
mul Pair a
a Pair b
b =
forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Pair a -> Pair b -> ((a, b), Triple c)
sumAndConvolvePair a -> b -> c
mul Pair a
a Pair b
b
{-# INLINE sumAndConvolvePair #-}
sumAndConvolvePair ::
(Additive.C a, Additive.C b, Additive.C c) =>
(a -> b -> c) ->
Pair a -> Pair b -> ((a,b), Triple c)
sumAndConvolvePair :: forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Pair a -> Pair b -> ((a, b), Triple c)
sumAndConvolvePair a -> b -> c
(!*!) (a
a0,a
a1) (b
b0,b
b1) =
let sa01 :: a
sa01 = a
a0forall a. C a => a -> a -> a
+a
a1
sb01 :: b
sb01 = b
b0forall a. C a => a -> a -> a
+b
b1
ab0 :: c
ab0 = a
a0a -> b -> c
!*!b
b0
ab1 :: c
ab1 = a
a1a -> b -> c
!*!b
b1
in ((a
sa01, b
sb01), (c
ab0, a
sa01a -> b -> c
!*!b
sb01forall a. C a => a -> a -> a
-(c
ab0forall a. C a => a -> a -> a
+c
ab1), c
ab1))
type Triple a = (a,a,a)
{-# INLINE convolvePairTriple #-}
convolvePairTriple ::
(Additive.C a, Additive.C b, Additive.C c) =>
(a -> b -> c) ->
Pair a -> Triple b -> (c,c,c,c)
convolvePairTriple :: forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Pair a -> Triple b -> (c, c, c, c)
convolvePairTriple a -> b -> c
(!*!) (a
a0,a
a1) (b
b0,b
b1,b
b2) =
let ab0 :: c
ab0 = a
a0a -> b -> c
!*!b
b0
ab1 :: c
ab1 = a
a1a -> b -> c
!*!b
b1
sa01 :: a
sa01 = a
a0forall a. C a => a -> a -> a
+a
a1; sb01 :: b
sb01 = b
b0forall a. C a => a -> a -> a
+b
b1; ab01 :: c
ab01 = a
sa01a -> b -> c
!*!b
sb01
in (c
ab0, c
ab01 forall a. C a => a -> a -> a
- (c
ab0forall a. C a => a -> a -> a
+c
ab1),
a
a0a -> b -> c
!*!b
b2 forall a. C a => a -> a -> a
+ c
ab1, a
a1a -> b -> c
!*!b
b2)
{-# INLINE convolveTriple #-}
convolveTriple ::
(Additive.C a, Additive.C b, Additive.C c) =>
(a -> b -> c) ->
Triple a -> Triple b -> (c,c,c,c,c)
convolveTriple :: forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Triple a -> Triple b -> (c, c, c, c, c)
convolveTriple a -> b -> c
mul Triple a
a Triple b
b =
forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Triple a -> Triple b -> ((a, b), (c, c, c, c, c))
sumAndConvolveTriple a -> b -> c
mul Triple a
a Triple b
b
{-# INLINE sumAndConvolveTriple #-}
sumAndConvolveTriple ::
(Additive.C a, Additive.C b, Additive.C c) =>
(a -> b -> c) ->
Triple a -> Triple b -> ((a,b), (c,c,c,c,c))
sumAndConvolveTriple :: forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Triple a -> Triple b -> ((a, b), (c, c, c, c, c))
sumAndConvolveTriple a -> b -> c
(!*!) (a
a0,a
a1,a
a2) (b
b0,b
b1,b
b2) =
let ab0 :: c
ab0 = a
a0a -> b -> c
!*!b
b0
ab1 :: c
ab1 = a
a1a -> b -> c
!*!b
b1
ab2 :: c
ab2 = a
a2a -> b -> c
!*!b
b2
sa01 :: a
sa01 = a
a0forall a. C a => a -> a -> a
+a
a1; sb01 :: b
sb01 = b
b0forall a. C a => a -> a -> a
+b
b1; ab01 :: c
ab01 = a
sa01a -> b -> c
!*!b
sb01
sa02 :: a
sa02 = a
a0forall a. C a => a -> a -> a
+a
a2; sb02 :: b
sb02 = b
b0forall a. C a => a -> a -> a
+b
b2; ab02 :: c
ab02 = a
sa02a -> b -> c
!*!b
sb02
sa012 :: a
sa012 = a
sa01forall a. C a => a -> a -> a
+a
a2
sb012 :: b
sb012 = b
sb01forall a. C a => a -> a -> a
+b
b2
in ((a
sa012, b
sb012),
(c
ab0, c
ab01 forall a. C a => a -> a -> a
- (c
ab0forall a. C a => a -> a -> a
+c
ab1),
c
ab02 forall a. C a => a -> a -> a
+ c
ab1 forall a. C a => a -> a -> a
- (c
ab0forall a. C a => a -> a -> a
+c
ab2),
a
sa012a -> b -> c
!*!b
sb012 forall a. C a => a -> a -> a
- c
ab02 forall a. C a => a -> a -> a
- c
ab01 forall a. C a => a -> a -> a
+ c
ab0, c
ab2))
{-# INLINE sumAndConvolveTripleAlt #-}
sumAndConvolveTripleAlt ::
(Additive.C a, Additive.C b, Additive.C c) =>
(a -> b -> c) ->
Triple a -> Triple b -> ((a,b), (c,c,c,c,c))
sumAndConvolveTripleAlt :: forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Triple a -> Triple b -> ((a, b), (c, c, c, c, c))
sumAndConvolveTripleAlt a -> b -> c
(!*!) (a
a0,a
a1,a
a2) (b
b0,b
b1,b
b2) =
let ab0 :: c
ab0 = a
a0a -> b -> c
!*!b
b0
ab1 :: c
ab1 = a
a1a -> b -> c
!*!b
b1
ab2 :: c
ab2 = a
a2a -> b -> c
!*!b
b2
sa01 :: a
sa01 = a
a0forall a. C a => a -> a -> a
+a
a1; sb01 :: b
sb01 = b
b0forall a. C a => a -> a -> a
+b
b1
ab01 :: c
ab01 = a
sa01a -> b -> c
!*!b
sb01 forall a. C a => a -> a -> a
- (c
ab0forall a. C a => a -> a -> a
+c
ab1)
sa02 :: a
sa02 = a
a0forall a. C a => a -> a -> a
+a
a2; sb02 :: b
sb02 = b
b0forall a. C a => a -> a -> a
+b
b2
ab02 :: c
ab02 = a
sa02a -> b -> c
!*!b
sb02 forall a. C a => a -> a -> a
- (c
ab0forall a. C a => a -> a -> a
+c
ab2)
sa12 :: a
sa12 = a
a1forall a. C a => a -> a -> a
+a
a2; sb12 :: b
sb12 = b
b1forall a. C a => a -> a -> a
+b
b2
ab12 :: c
ab12 = a
sa12a -> b -> c
!*!b
sb12 forall a. C a => a -> a -> a
- (c
ab1forall a. C a => a -> a -> a
+c
ab2)
in ((a
sa01forall a. C a => a -> a -> a
+a
a2, b
sb01forall a. C a => a -> a -> a
+b
b2),
(c
ab0, c
ab01, c
ab1forall a. C a => a -> a -> a
+c
ab02, c
ab12, c
ab2))
type Quadruple a = (a,a,a,a)
{-# INLINE convolveQuadruple #-}
convolveQuadruple ::
(Additive.C a, Additive.C b, Additive.C c) =>
(a -> b -> c) ->
Quadruple a -> Quadruple b -> (c,c,c,c,c,c,c)
convolveQuadruple :: forall a b c.
(C a, C b, C c) =>
(a -> b -> c)
-> Quadruple a -> Quadruple b -> (c, c, c, c, c, c, c)
convolveQuadruple a -> b -> c
mul Quadruple a
a Quadruple b
b =
forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a b c.
(C a, C b, C c) =>
(a -> b -> c)
-> Quadruple a -> Quadruple b -> ((a, b), (c, c, c, c, c, c, c))
sumAndConvolveQuadruple a -> b -> c
mul Quadruple a
a Quadruple b
b
{-# INLINE sumAndConvolveQuadruple #-}
sumAndConvolveQuadruple ::
(Additive.C a, Additive.C b, Additive.C c) =>
(a -> b -> c) ->
Quadruple a -> Quadruple b -> ((a,b), (c,c,c,c,c,c,c))
sumAndConvolveQuadruple :: forall a b c.
(C a, C b, C c) =>
(a -> b -> c)
-> Quadruple a -> Quadruple b -> ((a, b), (c, c, c, c, c, c, c))
sumAndConvolveQuadruple a -> b -> c
(!*!) (a
a0,a
a1,a
a2,a
a3) (b
b0,b
b1,b
b2,b
b3) =
let ab0 :: c
ab0 = a
a0a -> b -> c
!*!b
b0
ab1 :: c
ab1 = a
a1a -> b -> c
!*!b
b1
sa01 :: a
sa01 = a
a0forall a. C a => a -> a -> a
+a
a1; sb01 :: b
sb01 = b
b0forall a. C a => a -> a -> a
+b
b1
ab01 :: c
ab01 = a
sa01a -> b -> c
!*!b
sb01 forall a. C a => a -> a -> a
- (c
ab0forall a. C a => a -> a -> a
+c
ab1)
ab2 :: c
ab2 = a
a2a -> b -> c
!*!b
b2
ab3 :: c
ab3 = a
a3a -> b -> c
!*!b
b3
sa23 :: a
sa23 = a
a2forall a. C a => a -> a -> a
+a
a3; sb23 :: b
sb23 = b
b2forall a. C a => a -> a -> a
+b
b3
ab23 :: c
ab23 = a
sa23a -> b -> c
!*!b
sb23 forall a. C a => a -> a -> a
- (c
ab2forall a. C a => a -> a -> a
+c
ab3)
ab02 :: c
ab02 = (a
a0forall a. C a => a -> a -> a
+a
a2)a -> b -> c
!*!(b
b0forall a. C a => a -> a -> a
+b
b2)
ab13 :: c
ab13 = (a
a1forall a. C a => a -> a -> a
+a
a3)a -> b -> c
!*!(b
b1forall a. C a => a -> a -> a
+b
b3)
sa0123 :: a
sa0123 = a
sa01forall a. C a => a -> a -> a
+a
sa23
sb0123 :: b
sb0123 = b
sb01forall a. C a => a -> a -> a
+b
sb23
ab0123 :: c
ab0123 = a
sa0123a -> b -> c
!*!b
sb0123 forall a. C a => a -> a -> a
- (c
ab02forall a. C a => a -> a -> a
+c
ab13)
in ((a
sa0123, b
sb0123),
(c
ab0, c
ab01, c
ab1forall a. C a => a -> a -> a
+c
ab02forall a. C a => a -> a -> a
-(c
ab0forall a. C a => a -> a -> a
+c
ab2),
c
ab0123 forall a. C a => a -> a -> a
- (c
ab01forall a. C a => a -> a -> a
+c
ab23),
c
ab2forall a. C a => a -> a -> a
+c
ab13forall a. C a => a -> a -> a
-(c
ab1forall a. C a => a -> a -> a
+c
ab3), c
ab23, c
ab3))
{-# INLINE sumAndConvolveQuadrupleAlt #-}
sumAndConvolveQuadrupleAlt ::
(Additive.C a, Additive.C b, Additive.C c) =>
(a -> b -> c) ->
Quadruple a -> Quadruple b -> ((a,b), (c,c,c,c,c,c,c))
sumAndConvolveQuadrupleAlt :: forall a b c.
(C a, C b, C c) =>
(a -> b -> c)
-> Quadruple a -> Quadruple b -> ((a, b), (c, c, c, c, c, c, c))
sumAndConvolveQuadrupleAlt a -> b -> c
mul (a
a0,a
a1,a
a2,a
a3) (b
b0,b
b1,b
b2,b
b3) =
let (((a
sa02,a
sa13), (b
sb02,b
sb13)),
((c
c00,c
c01,c
c02), (c
c10,c
c11,c
c12), (c
c20,c
c21,c
c22))) =
forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Pair a -> Pair b -> ((a, b), Triple c)
sumAndConvolvePair (forall a b c.
(C a, C b, C c) =>
(a -> b -> c) -> Pair a -> Pair b -> Triple c
convolvePair a -> b -> c
mul)
((a
a0,a
a1),(a
a2,a
a3)) ((b
b0,b
b1),(b
b2,b
b3))
in ((a
sa02forall a. C a => a -> a -> a
+a
sa13, b
sb02forall a. C a => a -> a -> a
+b
sb13),
(c
c00,c
c01,c
c02forall a. C a => a -> a -> a
+c
c10,c
c11,c
c12forall a. C a => a -> a -> a
+c
c20,c
c21,c
c22))