{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Plain.Control (
   constant,
   linear,
   linearMultiscale,
   linearMultiscaleNeutral,
   linearStable,
   linearMean,
   line,
   exponential, exponentialMultiscale, exponentialStable,
   exponentialMultiscaleNeutral,
   exponential2, exponential2Multiscale, exponential2Stable,
   exponential2MultiscaleNeutral,
   exponentialFromTo, exponentialFromToMultiscale,
   vectorExponential,
   vectorExponential2,
   cosine, cosineMultiscale, cosineSubdiv, cosineStable,
   cubicHermite,
   cubicHermiteStable,

   -- used in Analysis
   curveMultiscale,
   curveMultiscaleNeutral,
   -- used in Generic.Control, Interpolation.Module
   cubicFunc,
   cosineWithSlope,
   ) where

import qualified Synthesizer.Plain.Signal as Sig

import Data.List (zipWith4, tails, )
import Data.List.HT (iterateAssociative, )

import qualified Algebra.Module                as Module
import qualified Algebra.Transcendental        as Trans
import qualified Algebra.Field                 as Field
import qualified Algebra.Ring                  as Ring
import qualified Algebra.Additive              as Additive

import Number.Complex (cis,real, )

import NumericPrelude.Numeric
import NumericPrelude.Base


{- * Control curve generation -}

constant :: y -> Sig.T y
constant :: forall y. y -> T y
constant = forall y. y -> T y
repeat


linear :: Additive.C y =>
      y   {-^ steepness -}
   -> y   {-^ initial value -}
   -> Sig.T y {-^ linear progression -}
linear :: forall y. C y => y -> y -> T y
linear y
d y
y0 = forall a. (a -> a) -> a -> [a]
iterate (y
dforall a. C a => a -> a -> a
+) y
y0

{- |
Minimize rounding errors by reducing number of operations per element
to a logarithmuc number.
-}
linearMultiscale :: Additive.C y =>
      y
   -> y
   -> Sig.T y
linearMultiscale :: forall y. C y => y -> y -> T y
linearMultiscale = forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale forall a. C a => a -> a -> a
(+)

{- |
Linear curve starting at zero.
-}
linearMultiscaleNeutral :: Additive.C y =>
      y
   -> Sig.T y
linearMultiscaleNeutral :: forall y. C y => y -> T y
linearMultiscaleNeutral y
slope =
   forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscaleNeutral forall a. C a => a -> a -> a
(+) y
slope forall a. C a => a
zero

{- |
As stable as the addition of time values.
-}
linearStable :: Ring.C y =>
      y
   -> y
   -> Sig.T y
linearStable :: forall y. C y => y -> y -> T y
linearStable y
d y
y0 =
   forall t y. C t => (t -> y) -> (y -> y -> y) -> t -> y -> T y
curveStable (y
dforall a. C a => a -> a -> a
*) forall a. C a => a -> a -> a
(+) y
1 y
y0


{- |
It computes the same like 'linear' but in a numerically more stable manner,
namely using a subdivision scheme.
The division needed is a division by two.

> 0       4       8
> 0   2   4   6   8
> 0 1 2 3 4 5 6 7 8
-}
linearMean :: Field.C y =>
      y
   -> y
   -> Sig.T y
linearMean :: forall y. C y => y -> y -> T y
linearMean y
d y
y0 = y
y0 forall a. a -> [a] -> [a]
:
   forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\y
pow [y]
xs -> y
y0forall a. C a => a -> a -> a
+y
pow forall a. a -> [a] -> [a]
: forall y. C y => T y -> T y
linearSubdivision [y]
xs)
         forall a. a
unreachable (forall a. (a -> a) -> a -> [a]
iterate (y
2forall a. C a => a -> a -> a
*) y
d)

{- | Intersperse linearly interpolated values. -}
linearSubdivision :: Field.C y =>
      Sig.T y
   -> Sig.T y
linearSubdivision :: forall y. C y => T y -> T y
linearSubdivision = forall y. (y -> y -> y) -> T y -> T y
subdivide (\y
x0 y
x1 -> (y
x0forall a. C a => a -> a -> a
+y
x1)forall a. C a => a -> a -> a
/y
2)


{- |
Linear curve of a fixed length.
The final value is not actually reached,
instead we stop one step before.
This way we can concatenate several lines
without duplicate adjacent values.
-}
line :: Field.C y =>
      Int     {-^ length -}
   -> (y,y)   {-^ initial and final value -}
   -> Sig.T y {-^ linear progression -}
line :: forall y. C y => Int -> (y, y) -> T y
line Int
n (y
y0,y
y1) =
   forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall y. C y => y -> y -> T y
linear ((y
y1forall a. C a => a -> a -> a
-y
y0) forall a. C a => a -> a -> a
/ forall a b. (C a, C b) => a -> b
fromIntegral Int
n) y
y0



exponential, exponentialMultiscale, exponentialStable :: Trans.C y =>
      y   {-^ time where the function reaches 1\/e of the initial value -}
   -> y   {-^ initial value -}
   -> Sig.T y {-^ exponential decay -}
exponential :: forall y. C y => y -> y -> T y
exponential y
time = forall a. (a -> a) -> a -> [a]
iterate (forall a. C a => a -> a -> a
* forall a. C a => a -> a
exp (- forall a. C a => a -> a
recip y
time))
exponentialMultiscale :: forall y. C y => y -> y -> T y
exponentialMultiscale y
time = forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale forall a. C a => a -> a -> a
(*) (forall a. C a => a -> a
exp (- forall a. C a => a -> a
recip y
time))
exponentialStable :: forall y. C y => y -> y -> T y
exponentialStable y
time = forall y t. (C y, C t) => (t -> y) -> t -> y -> T y
exponentialStableGen forall a. C a => a -> a
exp (- forall a. C a => a -> a
recip y
time)

exponentialMultiscaleNeutral :: Trans.C y =>
      y   {-^ time where the function reaches 1\/e of the initial value -}
   -> Sig.T y {-^ exponential decay -}
exponentialMultiscaleNeutral :: forall y. C y => y -> T y
exponentialMultiscaleNeutral y
time =
   forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscaleNeutral forall a. C a => a -> a -> a
(*) (forall a. C a => a -> a
exp (- forall a. C a => a -> a
recip y
time)) forall a. C a => a
one

exponential2, exponential2Multiscale, exponential2Stable :: Trans.C y =>
      y   {-^ half life -}
   -> y   {-^ initial value -}
   -> Sig.T y {-^ exponential decay -}
exponential2 :: forall y. C y => y -> y -> T y
exponential2 y
halfLife = forall a. (a -> a) -> a -> [a]
iterate (forall a. C a => a -> a -> a
*  y
0.5 forall a. C a => a -> a -> a
** forall a. C a => a -> a
recip y
halfLife)
exponential2Multiscale :: forall y. C y => y -> y -> T y
exponential2Multiscale y
halfLife = forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale forall a. C a => a -> a -> a
(*) (y
0.5 forall a. C a => a -> a -> a
** forall a. C a => a -> a
recip y
halfLife)
exponential2Stable :: forall y. C y => y -> y -> T y
exponential2Stable y
halfLife = forall y t. (C y, C t) => (t -> y) -> t -> y -> T y
exponentialStableGen (y
0.5 forall a. C a => a -> a -> a
**) (forall a. C a => a -> a
recip y
halfLife)

exponential2MultiscaleNeutral :: Trans.C y =>
      y   {-^ half life -}
   -> Sig.T y {-^ exponential decay -}
exponential2MultiscaleNeutral :: forall y. C y => y -> T y
exponential2MultiscaleNeutral y
halfLife =
   forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscaleNeutral forall a. C a => a -> a -> a
(*) (y
0.5 forall a. C a => a -> a -> a
** forall a. C a => a -> a
recip y
halfLife) forall a. C a => a
one


exponentialFromTo, exponentialFromToMultiscale :: Trans.C y =>
      y   {-^ time where the function reaches 1\/e of the initial value -}
   -> y   {-^ initial value -}
   -> y   {-^ value after given time -}
   -> Sig.T y {-^ exponential decay -}
exponentialFromTo :: forall y. C y => y -> y -> y -> T y
exponentialFromTo y
time y
y0 y
y1 =
   forall a. (a -> a) -> a -> [a]
iterate (forall a. C a => a -> a -> a
*  (y
y1forall a. C a => a -> a -> a
/y
y0) forall a. C a => a -> a -> a
** forall a. C a => a -> a
recip y
time) y
y0
exponentialFromToMultiscale :: forall y. C y => y -> y -> y -> T y
exponentialFromToMultiscale y
time y
y0 y
y1 =
   forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale forall a. C a => a -> a -> a
(*) ((y
y1forall a. C a => a -> a -> a
/y
y0) forall a. C a => a -> a -> a
** forall a. C a => a -> a
recip y
time) y
y0


exponentialStableGen :: (Ring.C y, Ring.C t) =>
      (t -> y)
   -> t
   -> y
   -> Sig.T y
exponentialStableGen :: forall y t. (C y, C t) => (t -> y) -> t -> y -> T y
exponentialStableGen t -> y
expFunc = forall t y. C t => (t -> y) -> (y -> y -> y) -> t -> y -> T y
curveStable t -> y
expFunc forall a. C a => a -> a -> a
(*)




{-| This is an extension of 'exponential' to vectors
    which is straight-forward but requires more explicit signatures.
    But since it is needed rarely I setup a separate function. -}
vectorExponential :: (Trans.C y, Module.C y v) =>
       y  {-^ time where the function reaches 1\/e of the initial value -}
   ->  v  {-^ initial value -}
   -> Sig.T v {-^ exponential decay -}
vectorExponential :: forall y v. (C y, C y v) => y -> v -> T v
vectorExponential y
time v
y0 = forall a. (a -> a) -> a -> [a]
iterate (forall a. C a => a -> a
exp (-y
1forall a. C a => a -> a -> a
/y
time) forall a v. C a v => a -> v -> v
*>) v
y0

vectorExponential2 :: (Trans.C y, Module.C y v) =>
       y  {-^ half life -}
   ->  v  {-^ initial value -}
   -> Sig.T v {-^ exponential decay -}
vectorExponential2 :: forall y v. (C y, C y v) => y -> v -> T v
vectorExponential2 y
halfLife v
y0 = forall a. (a -> a) -> a -> [a]
iterate (y
0.5forall a. C a => a -> a -> a
**(y
1forall a. C a => a -> a -> a
/y
halfLife) forall a v. C a v => a -> v -> v
*>) v
y0



cosine, cosineMultiscale, cosineSubdiv, cosineStable :: Trans.C y =>
       y  {-^ time t0 where  1 is approached -}
   ->  y  {-^ time t1 where -1 is approached -}
   -> Sig.T y {-^ a cosine wave where one half wave is between t0 and t1 -}
cosine :: forall y. C y => y -> y -> T y
cosine = forall y signal. C y => (y -> y -> signal) -> y -> y -> signal
cosineWithSlope forall a b. (a -> b) -> a -> b
$
   \y
d y
x -> forall a b. (a -> b) -> [a] -> [b]
map forall a. C a => a -> a
cos (forall y. C y => y -> y -> T y
linear y
d y
x)

cosineMultiscale :: forall y. C y => y -> y -> T y
cosineMultiscale = forall y signal. C y => (y -> y -> signal) -> y -> y -> signal
cosineWithSlope forall a b. (a -> b) -> a -> b
$
   \y
d y
x -> forall a b. (a -> b) -> [a] -> [b]
map forall a. T a -> a
real (forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale forall a. C a => a -> a -> a
(*) (forall a. C a => a -> T a
cis y
d) (forall a. C a => a -> T a
cis y
x))


{-
  cos (a-b) = cos a * cos b + sin a * sin b
  cos (a+b) = cos a * cos b - sin a * sin b
  cos  a    = (cos (a-b) + cos (a+b)) / (2 * cos b)

  Problem: (cos b) might be close to zero,
  example: Syn.cosineStable 1 (9::Double)
-}
cosineSubdiv :: forall y. C y => y -> y -> T y
cosineSubdiv =
   let aux :: a -> a -> [a]
aux a
d a
y0 =
          forall a. C a => a -> a
cos a
y0 forall a. a -> [a] -> [a]
:
            forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
pow [a]
xs -> forall a. C a => a -> a
cos(a
y0forall a. C a => a -> a -> a
+a
pow) forall a. a -> [a] -> [a]
: forall y. C y => y -> T y -> T y
cosineSubdivision a
pow [a]
xs)
                  forall a. a
unreachable (forall a. (a -> a) -> a -> [a]
iterate (a
2forall a. C a => a -> a -> a
*) a
d)
   in  forall y signal. C y => (y -> y -> signal) -> y -> y -> signal
cosineWithSlope forall y. C y => y -> y -> T y
aux

cosineSubdivision :: Trans.C y =>
      y
   -> Sig.T y
   -> Sig.T y
cosineSubdivision :: forall y. C y => y -> T y -> T y
cosineSubdivision y
angle =
   let k :: y
k = forall a. C a => a -> a
recip (y
2 forall a. C a => a -> a -> a
* forall a. C a => a -> a
cos y
angle)
   in  forall y. (y -> y -> y) -> T y -> T y
subdivide (\y
x0 y
x1 -> (y
x0forall a. C a => a -> a -> a
+y
x1)forall a. C a => a -> a -> a
*y
k)

cosineStable :: forall y. C y => y -> y -> T y
cosineStable = forall y signal. C y => (y -> y -> signal) -> y -> y -> signal
cosineWithSlope forall a b. (a -> b) -> a -> b
$
   \y
d y
x -> forall a b. (a -> b) -> [a] -> [b]
map forall a. T a -> a
real (forall y t. (C y, C t) => (t -> y) -> t -> y -> T y
exponentialStableGen forall a. C a => a -> T a
cis y
d (forall a. C a => a -> T a
cis y
x))


cosineWithSlope :: Trans.C y =>
      (y -> y -> signal)
   ->  y
   ->  y
   -> signal
cosineWithSlope :: forall y signal. C y => (y -> y -> signal) -> y -> y -> signal
cosineWithSlope y -> y -> signal
c y
t0 y
t1 =
   let inc :: y
inc = forall a. C a => a
piforall a. C a => a -> a -> a
/(y
t1forall a. C a => a -> a -> a
-y
t0)
   in  y -> y -> signal
c y
inc (-y
t0forall a. C a => a -> a -> a
*y
inc)


cubicHermite :: Field.C y => (y, (y,y)) -> (y, (y,y)) -> Sig.T y
cubicHermite :: forall y. C y => (y, (y, y)) -> (y, (y, y)) -> T y
cubicHermite (y, (y, y))
node0 (y, (y, y))
node1 =
   forall a b. (a -> b) -> [a] -> [b]
map (forall y. C y => (y, (y, y)) -> (y, (y, y)) -> y -> y
cubicFunc (y, (y, y))
node0 (y, (y, y))
node1) (forall y. C y => y -> y -> T y
linear y
1 y
0)

{- |
> 0                                     16
> 0               8                     16
> 0       4       8         12          16
> 0   2   4   6   8   10    12    14    16
> 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
-}
cubicFunc :: Field.C y => (y, (y,y)) -> (y, (y,y)) -> y -> y
cubicFunc :: forall y. C y => (y, (y, y)) -> (y, (y, y)) -> y -> y
cubicFunc (y
t0, (y
y0,y
dy0)) (y
t1, (y
y1,y
dy1)) y
t =
   let dt :: y
dt  = y
t0forall a. C a => a -> a -> a
-y
t1
       dt0 :: y
dt0 = y
tforall a. C a => a -> a -> a
-y
t0
       dt1 :: y
dt1 = y
tforall a. C a => a -> a -> a
-y
t1
       x0 :: y
x0  = y
dt1forall a. C a => a -> Integer -> a
^Integer
2
       x1 :: y
x1  = y
dt0forall a. C a => a -> Integer -> a
^Integer
2
   in  ((y
dy0forall a. C a => a -> a -> a
*y
dt0 forall a. C a => a -> a -> a
+ y
y0 forall a. C a => a -> a -> a
* (y
1forall a. C a => a -> a -> a
-y
2forall a. C a => a -> a -> a
/y
dtforall a. C a => a -> a -> a
*y
dt0)) forall a. C a => a -> a -> a
* y
x0 forall a. C a => a -> a -> a
+
        (y
dy1forall a. C a => a -> a -> a
*y
dt1 forall a. C a => a -> a -> a
+ y
y1 forall a. C a => a -> a -> a
* (y
1forall a. C a => a -> a -> a
+y
2forall a. C a => a -> a -> a
/y
dtforall a. C a => a -> a -> a
*y
dt1)) forall a. C a => a -> a -> a
* y
x1) forall a. C a => a -> a -> a
/ y
dtforall a. C a => a -> Integer -> a
^Integer
2
{-
cubic t0 (y0,dy0) t1 (y1,dy1) t =
   let x0 = ((t-t1) / (t0-t1))^2
       x1 = ((t-t0) / (t1-t0))^2
   in  y0 * x0 + y1 * x1 +
       (dy0 - y0*2/(t0-t1)) * (t-t0)*x0 +
       (dy1 - y1*2/(t1-t0)) * (t-t1)*x1
-}

cubicHermiteStable :: Field.C y => (y, (y,y)) -> (y, (y,y)) -> Sig.T y
cubicHermiteStable :: forall y. C y => (y, (y, y)) -> (y, (y, y)) -> T y
cubicHermiteStable (y, (y, y))
node0 (y, (y, y))
node1 =
   forall y. C y => (y, (y, y)) -> (y, (y, y)) -> y -> y
cubicFunc (y, (y, y))
node0 (y, (y, y))
node1 y
0 forall a. a -> [a] -> [a]
:
      forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\y
pow [y]
xs ->
                forall y. C y => (y, (y, y)) -> (y, (y, y)) -> y -> y
cubicFunc (y, (y, y))
node0 (y, (y, y))
node1 y
pow forall a. a -> [a] -> [a]
: forall a. [a] -> a
head [y]
xs forall a. a -> [a] -> [a]
:
                forall y. C y => (y, (y, y)) -> (y, (y, y)) -> y -> y
cubicFunc (y, (y, y))
node0 (y, (y, y))
node1 (y
3forall a. C a => a -> a -> a
*y
pow) forall a. a -> [a] -> [a]
: forall y. C y => T y -> T y
cubicSubdivision [y]
xs)
            forall a. a
unreachable (forall a. (a -> a) -> a -> [a]
iterate (y
2forall a. C a => a -> a -> a
*) y
1)

cubicSubdivision :: Field.C y => Sig.T y -> Sig.T y
cubicSubdivision :: forall y. C y => T y -> T y
cubicSubdivision T y
xs =
   let T y
xs0:T y
xs1:T y
xs2:T y
xs3:[T y]
_ = forall a. [a] -> [[a]]
tails T y
xs
       inter :: T y
inter = forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 (\y
x0 y
x1 y
x2 y
x3 -> (y
9forall a. C a => a -> a -> a
*(y
x1forall a. C a => a -> a -> a
+y
x2) forall a. C a => a -> a -> a
- (y
x0forall a. C a => a -> a -> a
+y
x3))forall a. C a => a -> a -> a
/y
16)
                        T y
xs0 T y
xs1 T y
xs2 T y
xs3
   in  forall a. [a] -> a
head T y
xs1 forall a. a -> [a] -> [a]
: forall a. T (a, a) -> T a
flattenPairs (forall a b. [a] -> [b] -> [(a, b)]
zip T y
inter T y
xs2)

{-
            foldr (\(pow0:pow1:_) ~(_:xs) ->
                      cos (y0+pow0) : cos (y0+pow1) : cos (y0+pow0+pow1) :
                         cosineSubdivision pow0 xs)
                  unreachable (tails (iterate (2*) d))
-}


{-
maybe cubicHermite could also be implemented in a Multiscale manner
using a difference scheme.

cubicHermiteMultiscale :: Field.C y => (y, (y,y)) -> (y, (y,y)) -> Sig.T y
cubicHermiteMultiscale node0@(t0,y0) node1@(t1,y1) =
   let -- could be inlined and simplified
       ys = map (cubicFunc node0 node1) [0,1,2,3]
       (d0:d1:d2:d3:_) = iterate (mapAdjacent substract) ys

I thought multiplying difference schemes could help somehow,
but it doesn't. :-(

cubicHermiteMultiscale

Leibniz rule for differences

D3(s+r) = D0(s)*D3(r) + 3*D1(s)*D2(r) + 3*D2(s)*D1(r) + D3(s)*D0(r)


mulDiffs4 :: Ring.C a => (a,a,a,a) -> (a,a,a,a) -> (a,a,a,a)
mulDiffs4 (r0,r1,r2,r3) (s0,s1,s2,s3) =
   (r0*s0,
    r0*s1 +   r1*s0,
    r0*s2 + 2*r1*s1 +   r2*s0,
    r0*s3 + 3*r1*s2 + 3*r2*s1 + r3*s0)

mulDiffs4zero :: Ring.C a => (a,a,a) -> (a,a,a) -> (a,a,a)
mulDiffs4zero (r0,r1,r2,r3) (s0,s1,s2,s3) =
   (r0*s0,
    r0*s1 +   r1*s0,
    r0*s2 + 2*r1*s1 +   r2*s0,
    r0*s3 + 3*r1*s2 + 3*r2*s1 + r3*s0)

mulDiffs3 :: Ring.C a => (a,a,a) -> (a,a,a) -> (a,a,a)
mulDiffs3 (r0,r1,r2) (s0,s1,s2) =
   (r0*s0,
    r0*s1 +   r1*s0,
    r0*s2 + 2*r1*s1 +   r2*s0)

mulDiffs3Karatsuba :: Ring.C a => (a,a,a) -> (a,a,a) -> (a,a,a)
mulDiffs3Karatsuba (r0,r1,r2) (s0,s1,s2) =
   let r0s0 = r0*s0
       r1s1 = r1*s1
   in  (r0s0,
        (r0+r1)*(s0+s1) - r0s0 - r1s1,
        r0*s2 + 2*r1s1 + r2*s0)
-}



{- * Auxiliary functions -}

curveStable :: (Additive.C t) =>
      (t -> y)
   -> (y -> y -> y)
   -> t
   -> y
   -> Sig.T y
curveStable :: forall t y. C t => (t -> y) -> (y -> y -> y) -> t -> y -> T y
curveStable t -> y
expFunc y -> y -> y
op t
time y
y0 =
   y
y0 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (y -> y -> y
op y
y0)
      (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
         (\t
e [y]
xs ->
            let k :: y
k = t -> y
expFunc t
e
            in  y
k forall a. a -> [a] -> [a]
: forall a b. (a -> (b, b)) -> T a -> T b
concatMapPair (\y
x -> (y
x, y -> y -> y
op y
x y
k)) [y]
xs)
       forall a. a
unreachable (forall a. (a -> a) -> a -> [a]
iterate forall t. C t => t -> t
double t
time))

unreachable :: a
unreachable :: forall a. a
unreachable = forall a. HasCallStack => [Char] -> a
error [Char]
"only reachable in infinity"

double :: Additive.C t => t -> t
double :: forall t. C t => t -> t
double t
t = t
tforall a. C a => a -> a -> a
+t
t

concatMapPair :: (a -> (b,b)) -> Sig.T a -> Sig.T b
concatMapPair :: forall a b. (a -> (b, b)) -> T a -> T b
concatMapPair a -> (b, b)
f = forall a. T (a, a) -> T a
flattenPairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map a -> (b, b)
f

flattenPairs :: Sig.T (a,a) -> Sig.T a
flattenPairs :: forall a. T (a, a) -> T a
flattenPairs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(a
a,a
b) T a
xs -> a
aforall a. a -> [a] -> [a]
:a
bforall a. a -> [a] -> [a]
:T a
xs) []

subdivide :: (y -> y -> y) -> Sig.T y -> Sig.T y
subdivide :: forall y. (y -> y -> y) -> T y -> T y
subdivide y -> y -> y
f xs0 :: T y
xs0@(y
x:T y
xs1) =
   y
x forall a. a -> [a] -> [a]
: forall a. T (a, a) -> T a
flattenPairs (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\y
x0 y
x1 -> (y -> y -> y
f y
x0 y
x1, y
x1)) T y
xs0 T y
xs1)
subdivide y -> y -> y
_ [] = []


_concatMapPair :: (a -> (b,b)) -> Sig.T a -> Sig.T b
_concatMapPair :: forall a b. (a -> (b, b)) -> T a -> T b
_concatMapPair a -> (b, b)
f = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((\(b
x,b
y) -> [b
x,b
y]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, b)
f)


curveMultiscale :: (y -> y -> y) -> y -> y -> Sig.T y
curveMultiscale :: forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale y -> y -> y
op y
d y
y0 =
   y
y0 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (y -> y -> y
op y
y0) (forall a. (a -> a -> a) -> a -> [a]
iterateAssociative y -> y -> y
op y
d)


curveMultiscaleNeutral :: (y -> y -> y) -> y -> y -> Sig.T y
curveMultiscaleNeutral :: forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscaleNeutral y -> y -> y
op y
d y
neutral =
   y
neutral forall a. a -> [a] -> [a]
: forall a. (a -> a -> a) -> a -> [a]
iterateAssociative y -> y -> y
op y
d