{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.State.Analysis (
   volumeMaximum,
   volumeEuclidean,
   volumeEuclideanSqr,
   volumeSum,
   volumeVectorMaximum,
   volumeVectorEuclidean,
   volumeVectorEuclideanSqr,
   volumeVectorSum,
   bounds,
   histogramDiscreteArray,
   histogramLinearArray,
   histogramDiscreteIntMap,
   histogramLinearIntMap,
   histogramIntMap,
   directCurrentOffset,
   scalarProduct,
   centroid,
   centroidRecompute,
   firstMoment,
   average,
   averageRecompute,
   rectify,
   zeros,
   flipFlopHysteresis,
   chirpTransform,
   ) where

import qualified Synthesizer.Plain.Analysis as Ana
import qualified Synthesizer.State.Control as Ctrl
import qualified Synthesizer.State.Signal  as Sig

import qualified Algebra.Algebraic             as Algebraic
import qualified Algebra.RealField             as RealField
import qualified Algebra.Field                 as Field
import qualified Algebra.RealRing              as RealRing
import qualified Algebra.Absolute              as Absolute
import qualified Algebra.Ring                  as Ring
import qualified Algebra.Additive              as Additive

import qualified Algebra.NormedSpace.Maximum   as NormedMax
import qualified Algebra.NormedSpace.Euclidean as NormedEuc
import qualified Algebra.NormedSpace.Sum       as NormedSum

import qualified Data.IntMap as IntMap
import qualified Data.Array as Array

import Data.Array (accumArray)

import NumericPrelude.Numeric
import NumericPrelude.Base


{- * Notions of volume -}

{- |
Volume based on Manhattan norm.
-}
{-# INLINE volumeMaximum #-}
volumeMaximum :: (RealRing.C y) => Sig.T y -> y
volumeMaximum :: forall y. C y => T y -> y
volumeMaximum =
   (y -> y -> y) -> y -> T y -> y
forall acc x. (acc -> x -> acc) -> acc -> T x -> acc
Sig.foldL y -> y -> y
forall a. Ord a => a -> a -> a
max y
forall a. C a => a
zero (T y -> y) -> (T y -> T y) -> T y -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T y -> T y
forall y. C y => T y -> T y
rectify
--   maximum . rectify

{- |
Volume based on Energy norm.
-}
{-# INLINE volumeEuclidean #-}
volumeEuclidean :: (Algebraic.C y) => Sig.T y -> y
volumeEuclidean :: forall y. C y => T y -> y
volumeEuclidean =
   y -> y
forall a. C a => a -> a
Algebraic.sqrt (y -> y) -> (T y -> y) -> T y -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T y -> y
forall y. C y => T y -> y
volumeEuclideanSqr

{-# INLINE volumeEuclideanSqr #-}
volumeEuclideanSqr :: (Field.C y) => Sig.T y -> y
volumeEuclideanSqr :: forall y. C y => T y -> y
volumeEuclideanSqr =
   T y -> y
forall y. C y => T y -> y
average (T y -> y) -> (T y -> T y) -> T y -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y -> y) -> T y -> T y
forall a b. (a -> b) -> T a -> T b
Sig.map y -> y
forall a. C a => a -> a
sqr

{- |
Volume based on Sum norm.
-}
{-# INLINE volumeSum #-}
volumeSum :: (Field.C y, Absolute.C y) => Sig.T y -> y
volumeSum :: forall y. (C y, C y) => T y -> y
volumeSum = T y -> y
forall y. C y => T y -> y
average (T y -> y) -> (T y -> T y) -> T y -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T y -> T y
forall y. C y => T y -> T y
rectify



{- |
Volume based on Manhattan norm.
-}
{-# INLINE volumeVectorMaximum #-}
volumeVectorMaximum :: (NormedMax.C y yv, Ord y) => Sig.T yv -> y
volumeVectorMaximum :: forall y yv. (C y yv, Ord y) => T yv -> y
volumeVectorMaximum =
   (y -> y -> y) -> y -> T y -> y
forall acc x. (acc -> x -> acc) -> acc -> T x -> acc
Sig.foldL y -> y -> y
forall a. Ord a => a -> a -> a
max y
forall a. C a => a
zero (T y -> y) -> (T yv -> T y) -> T yv -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (yv -> y) -> T yv -> T y
forall a b. (a -> b) -> T a -> T b
Sig.map yv -> y
forall a v. C a v => v -> a
NormedMax.norm
--   NormedMax.norm
--   maximum . Sig.map NormedMax.norm

{- |
Volume based on Energy norm.
-}
{-# INLINE volumeVectorEuclidean #-}
volumeVectorEuclidean :: (Algebraic.C y, NormedEuc.C y yv) => Sig.T yv -> y
volumeVectorEuclidean :: forall y yv. (C y, C y yv) => T yv -> y
volumeVectorEuclidean =
   y -> y
forall a. C a => a -> a
Algebraic.sqrt (y -> y) -> (T yv -> y) -> T yv -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T yv -> y
forall y yv. (C y, Sqr y yv) => T yv -> y
volumeVectorEuclideanSqr

{-# INLINE volumeVectorEuclideanSqr #-}
volumeVectorEuclideanSqr :: (Field.C y, NormedEuc.Sqr y yv) => Sig.T yv -> y
volumeVectorEuclideanSqr :: forall y yv. (C y, Sqr y yv) => T yv -> y
volumeVectorEuclideanSqr =
   T y -> y
forall y. C y => T y -> y
average (T y -> y) -> (T yv -> T y) -> T yv -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (yv -> y) -> T yv -> T y
forall a b. (a -> b) -> T a -> T b
Sig.map yv -> y
forall a v. Sqr a v => v -> a
NormedEuc.normSqr

{- |
Volume based on Sum norm.
-}
{-# INLINE volumeVectorSum #-}
volumeVectorSum :: (NormedSum.C y yv, Field.C y) => Sig.T yv -> y
volumeVectorSum :: forall y yv. (C y yv, C y) => T yv -> y
volumeVectorSum =
   T y -> y
forall y. C y => T y -> y
average (T y -> y) -> (T yv -> T y) -> T yv -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (yv -> y) -> T yv -> T y
forall a b. (a -> b) -> T a -> T b
Sig.map yv -> y
forall a v. C a v => v -> a
NormedSum.norm




{- |
Compute minimum and maximum value of the stream the efficient way.
Input list must be non-empty and finite.
-}
{-# INLINE bounds #-}
bounds :: (Ord y) => Sig.T y -> (y,y)
bounds :: forall y. Ord y => T y -> (y, y)
bounds =
   (y, y) -> (y -> T y -> (y, y)) -> T y -> (y, y)
forall b a. b -> (a -> T a -> b) -> T a -> b
Sig.switchL
      ([Char] -> (y, y)
forall a. HasCallStack => [Char] -> a
error [Char]
"Analysis.bounds: List must contain at least one element.")
      (\y
x T y
xs ->
          ((y, y) -> y -> (y, y)) -> (y, y) -> T y -> (y, y)
forall acc x. (acc -> x -> acc) -> acc -> T x -> acc
Sig.foldL (\(y
minX,y
maxX) y
y -> (y -> y -> y
forall a. Ord a => a -> a -> a
min y
y y
minX, y -> y -> y
forall a. Ord a => a -> a -> a
max y
y y
maxX)) (y
x,y
x) T y
xs)



{- * Miscellaneous -}

{-
histogram:
    length x = sum (histogramDiscrete x)

    units:
    1) histogram (amplify k x) = timestretch k (amplify (1/k) (histogram x))
    2) histogram (timestretch k x) = amplify k (histogram x)
    timestretch: k -> (s -> V) -> (k*s -> V)
    amplify:     k -> (s -> V) -> (s -> k*V)
    histogram:   (a -> b) -> (a^ia*b^ib -> a^ja*b^jb)
    x:           (s -> V)
    1) => (s^ia*(k*V)^ib -> s^ja*(k*V)^jb)
              = (s^ia*V^ib*k -> s^ja*V^jb/k)
       => ib=1, jb=-1
    2) => ((k*s)^ia*V^ib -> (k*s)^ja*V^jb)
              = (s^ia*V^ib -> s^ja*V^jb*k)
       => ia=0, ja=1
    histogram:   (s -> V) -> (V -> s/V)
histogram':
    integral (histogram' x) = integral x
    histogram' (amplify k x) = timestretch k (histogram' x)
    histogram' (timestretch k x) = amplify k (histogram' x)
     -> this does only apply if we slice the area horizontally
        and sum the slice up at each level,
        we must also restrict to the positive values,
        this is not quite the usual histogram
-}

{- |
Input list must be finite.
List is scanned twice, but counting may be faster.
-}
{-# INLINE histogramDiscreteArray #-}
histogramDiscreteArray :: Sig.T Int -> (Int, Sig.T Int)
histogramDiscreteArray :: T Int -> (Int, T Int)
histogramDiscreteArray =
   [Char] -> (T Int -> (Int, T Int)) -> T Int -> (Int, T Int)
forall y. [Char] -> (T y -> (Int, T y)) -> T y -> (Int, T y)
withAtLeast1 [Char]
"histogramDiscreteArray" ((T Int -> (Int, T Int)) -> T Int -> (Int, T Int))
-> (T Int -> (Int, T Int)) -> T Int -> (Int, T Int)
forall a b. (a -> b) -> a -> b
$ \ T Int
x ->
   let hist :: Array Int Int
hist =
          (Int -> Int -> Int)
-> Int -> (Int, Int) -> [(Int, Int)] -> Array Int Int
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray Int -> Int -> Int
forall a. C a => a -> a -> a
(+) Int
forall a. C a => a
zero
             (T Int -> (Int, Int)
forall y. Ord y => T y -> (y, y)
bounds T Int
x) (T Int -> [(Int, Int)]
forall i. T i -> [(i, Int)]
attachOne T Int
x)
   in  ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Array Int Int -> (Int, Int)
forall i e. Array i e -> (i, i)
Array.bounds Array Int Int
hist), [Int] -> T Int
forall y. [y] -> T y
Sig.fromList (Array Int Int -> [Int]
forall i e. Array i e -> [e]
Array.elems Array Int Int
hist))


{- |
Input list must be finite.
If the input signal is empty, the offset is @undefined@.
List is scanned twice, but counting may be faster.
The sum of all histogram values is one less than the length of the signal.
-}
{-# INLINE histogramLinearArray #-}
histogramLinearArray :: RealField.C y => Sig.T y -> (Int, Sig.T y)
histogramLinearArray :: forall y. C y => T y -> (Int, T y)
histogramLinearArray =
   [Char] -> (T y -> (Int, T y)) -> T y -> (Int, T y)
forall y. C y => [Char] -> (T y -> (Int, T y)) -> T y -> (Int, T y)
withAtLeast2 [Char]
"histogramLinearArray" ((T y -> (Int, T y)) -> T y -> (Int, T y))
-> (T y -> (Int, T y)) -> T y -> (Int, T y)
forall a b. (a -> b) -> a -> b
$ \ T y
x ->
   let (y
xMin,y
xMax) = T y -> (y, y)
forall y. Ord y => T y -> (y, y)
bounds T y
x
       hist :: Array Int y
hist =
          (y -> y -> y) -> y -> (Int, Int) -> [(Int, y)] -> Array Int y
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray y -> y -> y
forall a. C a => a -> a -> a
(+) y
forall a. C a => a
zero
             (y -> Int
forall b. C b => y -> b
forall a b. (C a, C b) => a -> b
floor y
xMin, y -> Int
forall b. C b => y -> b
forall a b. (C a, C b) => a -> b
floor y
xMax)
             (T y -> [(Int, y)]
forall y. C y => T y -> [(Int, y)]
meanValues T y
x)
   in  ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Array Int y -> (Int, Int)
forall i e. Array i e -> (i, i)
Array.bounds Array Int y
hist), [y] -> T y
forall y. [y] -> T y
Sig.fromList (Array Int y -> [y]
forall i e. Array i e -> [e]
Array.elems Array Int y
hist))

{- |
Input list must be finite.
If the input signal is empty, the offset is @undefined@.
List is scanned once, counting may be slower.
-}
{-# INLINE histogramDiscreteIntMap #-}
histogramDiscreteIntMap :: Sig.T Int -> (Int, Sig.T Int)
histogramDiscreteIntMap :: T Int -> (Int, T Int)
histogramDiscreteIntMap =
   [Char] -> (T Int -> (Int, T Int)) -> T Int -> (Int, T Int)
forall y. [Char] -> (T y -> (Int, T y)) -> T y -> (Int, T y)
withAtLeast1 [Char]
"histogramDiscreteIntMap" ((T Int -> (Int, T Int)) -> T Int -> (Int, T Int))
-> (T Int -> (Int, T Int)) -> T Int -> (Int, T Int)
forall a b. (a -> b) -> a -> b
$ \ T Int
x ->
   let hist :: IntMap Int
hist = (Int -> Int -> Int) -> [(Int, Int)] -> IntMap Int
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith Int -> Int -> Int
forall a. C a => a -> a -> a
(+) (T Int -> [(Int, Int)]
forall i. T i -> [(i, Int)]
attachOne T Int
x)
   in  case IntMap Int -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap Int
hist of
          [] -> [Char] -> (Int, T Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"histogramDiscreteIntMap: the list was non-empty before processing ..."
          fAll :: [(Int, Int)]
fAll@((Int
fIndex,Int
fHead):[(Int, Int)]
fs) -> (Int
fIndex,
              [Int] -> T Int
forall y. [y] -> T y
Sig.fromList ([Int] -> T Int) -> [Int] -> T Int
forall a b. (a -> b) -> a -> b
$
              Int
fHead Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:
              [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (((Int, Int) -> (Int, Int) -> [Int])
-> [(Int, Int)] -> [(Int, Int)] -> [[Int]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
                 (\(Int
i0,Int
_) (Int
i1,Int
f1) -> Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Int
i1Int -> Int -> Int
forall a. C a => a -> a -> a
-Int
i0Int -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) Int
forall a. C a => a
zero [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
f1])
                 [(Int, Int)]
fAll [(Int, Int)]
fs))

{-# INLINE histogramLinearIntMap #-}
histogramLinearIntMap :: RealField.C y => Sig.T y -> (Int, Sig.T y)
histogramLinearIntMap :: forall y. C y => T y -> (Int, T y)
histogramLinearIntMap =
   [Char] -> (T y -> (Int, T y)) -> T y -> (Int, T y)
forall y. C y => [Char] -> (T y -> (Int, T y)) -> T y -> (Int, T y)
withAtLeast2 [Char]
"histogramLinearIntMap" ((T y -> (Int, T y)) -> T y -> (Int, T y))
-> (T y -> (Int, T y)) -> T y -> (Int, T y)
forall a b. (a -> b) -> a -> b
$ \ T y
x ->
   let hist :: IntMap y
hist = (y -> y -> y) -> [(Int, y)] -> IntMap y
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith y -> y -> y
forall a. C a => a -> a -> a
(+) (T y -> [(Int, y)]
forall y. C y => T y -> [(Int, y)]
meanValues T y
x)
   -- we can rely on the fact that the keys are contiguous
       (Int
startKey:[Int]
_, [y]
elems) = [(Int, y)] -> ([Int], [y])
forall a b. [(a, b)] -> ([a], [b])
unzip (IntMap y -> [(Int, y)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap y
hist)
   in  (Int
startKey, [y] -> T y
forall y. [y] -> T y
Sig.fromList [y]
elems)
   -- This doesn't work, due to a bug in IntMap of GHC-6.4.1
   -- in  (head (IntMap.keys hist), IntMap.elems hist)

{-# INLINE withAtLeast1 #-}
withAtLeast1 ::
   String ->
   (Sig.T y -> (Int, Sig.T y)) ->
   Sig.T y ->
   (Int, Sig.T y)
withAtLeast1 :: forall y. [Char] -> (T y -> (Int, T y)) -> T y -> (Int, T y)
withAtLeast1 [Char]
name T y -> (Int, T y)
f T y
x =
   (Int, T y)
-> ((y, T y) -> (Int, T y)) -> Maybe (y, T y) -> (Int, T y)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      ([Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": no bounds found"), T y
forall a. T a
Sig.empty)
      ((Int, T y) -> (y, T y) -> (Int, T y)
forall a b. a -> b -> a
const (T y -> (Int, T y)
f T y
x)) (Maybe (y, T y) -> (Int, T y)) -> Maybe (y, T y) -> (Int, T y)
forall a b. (a -> b) -> a -> b
$
   T y -> Maybe (y, T y)
forall a. T a -> Maybe (a, T a)
Sig.viewL T y
x

{-# INLINE withAtLeast2 #-}
withAtLeast2 :: (RealRing.C y) =>
   String ->
   (Sig.T y -> (Int, Sig.T y)) ->
   Sig.T y ->
   (Int, Sig.T y)
withAtLeast2 :: forall y. C y => [Char] -> (T y -> (Int, T y)) -> T y -> (Int, T y)
withAtLeast2 [Char]
name T y -> (Int, T y)
f T y
x =
   (Int, T y)
-> ((y, T y) -> (Int, T y)) -> Maybe (y, T y) -> (Int, T y)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      ([Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": no bounds found"), T y
forall a. T a
Sig.empty)
      (\(y
y,T y
ys) ->
           if T y -> Bool
forall a. T a -> Bool
Sig.null T y
ys
             then (y -> Int
forall b. C b => y -> b
forall a b. (C a, C b) => a -> b
floor y
y, T y
forall a. T a
Sig.empty)
             else T y -> (Int, T y)
f T y
x) (Maybe (y, T y) -> (Int, T y)) -> Maybe (y, T y) -> (Int, T y)
forall a b. (a -> b) -> a -> b
$
   T y -> Maybe (y, T y)
forall a. T a -> Maybe (a, T a)
Sig.viewL T y
x

{-
The bug in IntMap GHC-6.4.1 is:

*Synthesizer.Plain.Analysis> IntMap.keys $ IntMap.fromList $ [(0,0),(-1,-1::Int)]
[0,-1]
*Synthesizer.Plain.Analysis> IntMap.elems $ IntMap.fromList $ [(0,0),(-1,-1::Int)]
[0,-1]
*Synthesizer.Plain.Analysis> IntMap.assocs $ IntMap.fromList $ [(0,0),(-1,-1::Int)]
[(0,0),(-1,-1)]

The bug has gone in IntMap as shipped with GHC-6.6.
-}

{-# INLINE histogramIntMap #-}
histogramIntMap :: (RealField.C y) => y -> Sig.T y -> (Int, Sig.T Int)
histogramIntMap :: forall y. C y => y -> T y -> (Int, T Int)
histogramIntMap y
binsPerUnit =
   T Int -> (Int, T Int)
histogramDiscreteIntMap (T Int -> (Int, T Int)) -> (T y -> T Int) -> T y -> (Int, T Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. y -> T y -> T Int
forall y. C y => y -> T y -> T Int
quantize y
binsPerUnit

{-# INLINE quantize #-}
quantize :: (RealRing.C y) => y -> Sig.T y -> Sig.T Int
quantize :: forall y. C y => y -> T y -> T Int
quantize y
binsPerUnit = (y -> Int) -> T y -> T Int
forall a b. (a -> b) -> T a -> T b
Sig.map (y -> Int
forall b. C b => y -> b
forall a b. (C a, C b) => a -> b
floor (y -> Int) -> (y -> y) -> y -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y
binsPerUnity -> y -> y
forall a. C a => a -> a -> a
*))

{-# INLINE attachOne #-}
attachOne :: Sig.T i -> [(i,Int)]
attachOne :: forall i. T i -> [(i, Int)]
attachOne = T (i, Int) -> [(i, Int)]
forall y. T y -> [y]
Sig.toList (T (i, Int) -> [(i, Int)])
-> (T i -> T (i, Int)) -> T i -> [(i, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> (i, Int)) -> T i -> T (i, Int)
forall a b. (a -> b) -> T a -> T b
Sig.map (\i
i -> (i
i,Int
forall a. C a => a
one))

{-# INLINE meanValues #-}
meanValues :: RealField.C y => Sig.T y -> [(Int,y)]
meanValues :: forall y. C y => T y -> [(Int, y)]
meanValues = ((y, y) -> [(Int, y)]) -> [(y, y)] -> [(Int, y)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (y, y) -> [(Int, y)]
forall y. C y => (y, y) -> [(Int, y)]
Ana.spread ([(y, y)] -> [(Int, y)]) -> (T y -> [(y, y)]) -> T y -> [(Int, y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (y, y) -> [(y, y)]
forall y. T y -> [y]
Sig.toList (T (y, y) -> [(y, y)]) -> (T y -> T (y, y)) -> T y -> [(y, y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y -> y -> (y, y)) -> T y -> T (y, y)
forall a b. (a -> a -> b) -> T a -> T b
Sig.mapAdjacent (,)

{- |
Requires finite length.
This is identical to the arithmetic mean.
-}
{-# INLINE directCurrentOffset #-}
directCurrentOffset :: Field.C y => Sig.T y -> y
directCurrentOffset :: forall y. C y => T y -> y
directCurrentOffset = T y -> y
forall y. C y => T y -> y
average


{-# INLINE scalarProduct #-}
scalarProduct :: Ring.C y => Sig.T y -> Sig.T y -> y
scalarProduct :: forall y. C y => T y -> T y -> y
scalarProduct T y
xs T y
ys =
   T y -> y
forall a. C a => T a -> a
Sig.sum ((y -> y -> y) -> T y -> T y -> T y
forall a b c. (a -> b -> c) -> T a -> T b -> T c
Sig.zipWith y -> y -> y
forall a. C a => a -> a -> a
(*) T y
xs T y
ys)

{- |
'directCurrentOffset' must be non-zero.
-}
{-# INLINE centroid #-}
centroid :: Field.C y => Sig.T y -> y
centroid :: forall y. C y => T y -> y
centroid =
   (y -> y -> y) -> (y, y) -> y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry y -> y -> y
forall a. C a => a -> a -> a
(/) ((y, y) -> y) -> (T y -> (y, y)) -> T y -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T (y, y) -> (y, y)
forall a. C a => T a -> a
Sig.sum (T (y, y) -> (y, y)) -> (T y -> T (y, y)) -> T y -> (y, y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (y -> y -> (y, y)) -> T y -> T y -> T (y, y)
forall a b c. (a -> b -> c) -> T a -> T b -> T c
Sig.zipWith
      (\y
k y
x -> (y
ky -> y -> y
forall a. C a => a -> a -> a
*y
x, y
x))
      ((y -> y) -> y -> T y
forall a. (a -> a) -> a -> T a
Sig.iterate (y
forall a. C a => a
oney -> y -> y
forall a. C a => a -> a -> a
+) y
forall a. C a => a
zero)

centroidRecompute :: Field.C y => Sig.T y -> y
centroidRecompute :: forall y. C y => T y -> y
centroidRecompute T y
xs =
   T y -> y
forall y. C y => T y -> y
firstMoment T y
xs y -> y -> y
forall a. C a => a -> a -> a
/ T y -> y
forall a. C a => T a -> a
Sig.sum T y
xs

{-# INLINE firstMoment #-}
firstMoment :: Field.C y => Sig.T y -> y
firstMoment :: forall y. C y => T y -> y
firstMoment T y
xs =
   T y -> T y -> y
forall y. C y => T y -> T y -> y
scalarProduct ((y -> y) -> y -> T y
forall a. (a -> a) -> a -> T a
Sig.iterate (y
forall a. C a => a
oney -> y -> y
forall a. C a => a -> a -> a
+) y
forall a. C a => a
zero) T y
xs


{-# INLINE average #-}
average :: Field.C y => Sig.T y -> y
average :: forall y. C y => T y -> y
average =
   (y -> y -> y) -> (y, y) -> y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry y -> y -> y
forall a. C a => a -> a -> a
(/) ((y, y) -> y) -> (T y -> (y, y)) -> T y -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T (y, y) -> (y, y)
forall a. C a => T a -> a
Sig.sum (T (y, y) -> (y, y)) -> (T y -> T (y, y)) -> T y -> (y, y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (y -> (y, y)) -> T y -> T (y, y)
forall a b. (a -> b) -> T a -> T b
Sig.map ((y -> y -> (y, y)) -> y -> y -> (y, y)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) y
forall a. C a => a
one)

averageRecompute :: Field.C y => Sig.T y -> y
averageRecompute :: forall y. C y => T y -> y
averageRecompute T y
x =
   T y -> y
forall a. C a => T a -> a
Sig.sum T y
x y -> y -> y
forall a. C a => a -> a -> a
/ Int -> y
forall a b. (C a, C b) => a -> b
fromIntegral (T y -> Int
forall a. T a -> Int
Sig.length T y
x)

{-# INLINE rectify #-}
rectify :: Absolute.C y => Sig.T y -> Sig.T y
rectify :: forall y. C y => T y -> T y
rectify = (y -> y) -> T y -> T y
forall a b. (a -> b) -> T a -> T b
Sig.map y -> y
forall a. C a => a -> a
abs

{- |
Detects zeros (sign changes) in a signal.
This can be used as a simple measure of the portion
of high frequencies or noise in the signal.
It ca be used as voiced\/unvoiced detector in a vocoder.

@zeros x !! n@ is @True@ if and only if
@(x !! n >= 0) \/= (x !! (n+1) >= 0)@.
The result will be one value shorter than the input.
-}
{-# INLINE zeros #-}
zeros :: (Ord y, Additive.C y) => Sig.T y -> Sig.T Bool
zeros :: forall y. (Ord y, C y) => T y -> T Bool
zeros =
   (Bool -> Bool -> Bool) -> T Bool -> T Bool
forall a b. (a -> a -> b) -> T a -> T b
Sig.mapAdjacent Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (T Bool -> T Bool) -> (T y -> T Bool) -> T y -> T Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y -> Bool) -> T y -> T Bool
forall a b. (a -> b) -> T a -> T b
Sig.map (y -> y -> Bool
forall a. Ord a => a -> a -> Bool
>=y
forall a. C a => a
zero)



{- |
Detect thresholds with a hysteresis.
-}
{-# INLINE flipFlopHysteresis #-}
flipFlopHysteresis :: (Ord y) =>
   (y,y) -> Ana.BinaryLevel -> Sig.T y -> Sig.T Ana.BinaryLevel
flipFlopHysteresis :: forall y. Ord y => (y, y) -> BinaryLevel -> T y -> T BinaryLevel
flipFlopHysteresis (y, y)
bnds = (BinaryLevel -> y -> BinaryLevel)
-> BinaryLevel -> T y -> T BinaryLevel
forall acc x. (acc -> x -> acc) -> acc -> T x -> T acc
Sig.scanL ((y, y) -> BinaryLevel -> y -> BinaryLevel
forall a. Ord a => (a, a) -> BinaryLevel -> a -> BinaryLevel
Ana.flipFlopHysteresisStep (y, y)
bnds)

{- |
Almost naive implementation of the chirp transform,
a generalization of the Fourier transform.

More sophisticated algorithms like Rader, Cooley-Tukey, Winograd, Prime-Factor may follow.
-}
{-# INLINE chirpTransform #-}
chirpTransform :: Ring.C y =>
   y -> Sig.T y -> Sig.T y
chirpTransform :: forall y. C y => y -> T y -> T y
chirpTransform y
z T y
xs =
   (T y -> y) -> T (T y) -> T y
forall a b. (a -> b) -> T a -> T b
Sig.map (T y -> T y -> y
forall y. C y => T y -> T y -> y
scalarProduct T y
xs) (T (T y) -> T y) -> T (T y) -> T y
forall a b. (a -> b) -> a -> b
$
   (y -> T y) -> T y -> T (T y)
forall a b. (a -> b) -> T a -> T b
Sig.map (\y
zn -> (y -> y -> y) -> y -> y -> T y
forall y. (y -> y -> y) -> y -> y -> T y
Ctrl.curveMultiscaleNeutral y -> y -> y
forall a. C a => a -> a -> a
(*) y
zn y
forall a. C a => a
one) (T y -> T (T y)) -> T y -> T (T y)
forall a b. (a -> b) -> a -> b
$
   (y -> y -> y) -> y -> y -> T y
forall y. (y -> y -> y) -> y -> y -> T y
Ctrl.curveMultiscaleNeutral y -> y -> y
forall a. C a => a -> a -> a
(*) y
z y
forall a. C a => a
one