{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Plain.Analysis (
volumeMaximum,
volumeEuclidean,
volumeEuclideanSqr,
volumeSum,
volumeVectorMaximum,
volumeVectorEuclidean,
volumeVectorEuclideanSqr,
volumeVectorSum,
bounds,
histogramDiscreteArray,
histogramLinearArray,
histogramDiscreteIntMap,
histogramLinearIntMap,
histogramIntMap,
directCurrentOffset,
scalarProduct,
centroid,
centroidAlt,
firstMoment,
average,
rectify,
zeros,
BinaryLevel(Low, High),
binaryLevelFromBool,
binaryLevelToNumber,
flipFlopHysteresis,
flipFlopHysteresisStep,
chirpTransform,
binarySign,
deltaSigmaModulation,
deltaSigmaModulationPositive,
spread,
) where
import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.Plain.Control as Ctrl
import qualified Synthesizer.Plain.Filter.Recursive.Integration as Integration
import qualified Data.NonEmpty as NonEmpty
import qualified Data.Array as Array
import qualified Data.IntMap as IntMap
import Data.Tuple.HT (sortPair)
import Data.Array (accumArray)
import Data.List (foldl', )
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 NumericPrelude.Numeric
import NumericPrelude.Base
volumeMaximum :: (RealRing.C y) => Sig.T y -> y
volumeMaximum :: forall y. C y => T y -> y
volumeMaximum =
(y -> y -> y) -> y -> [y] -> y
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl y -> y -> y
forall a. Ord a => a -> a -> a
max y
forall a. C a => a
zero ([y] -> y) -> ([y] -> [y]) -> [y] -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [y] -> [y]
forall y. C y => T y -> T y
rectify
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
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) -> [a] -> [b]
map y -> y
forall a. C a => a -> a
sqr
volumeSum :: (Absolute.C y, Field.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
volumeVectorMaximum :: (NormedMax.C y yv, Ord y) => Sig.T yv -> y
volumeVectorMaximum :: forall y yv. (C y yv, Ord y) => T yv -> y
volumeVectorMaximum =
T yv -> y
forall a v. C a v => v -> a
NormedMax.norm
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
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) -> [a] -> [b]
map yv -> y
forall a v. Sqr a v => v -> a
NormedEuc.normSqr
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) -> [a] -> [b]
map yv -> y
forall a v. C a v => v -> a
NormedSum.norm
bounds :: Ord y => NonEmpty.T Sig.T y -> (y,y)
bounds :: forall y. Ord y => T [] y -> (y, y)
bounds (NonEmpty.Cons y
x T y
xs) =
((y, y) -> y -> (y, y)) -> (y, y) -> T y -> (y, y)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
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
histogramDiscreteArray :: NonEmpty.T Sig.T Int -> (Int, Sig.T Int)
histogramDiscreteArray :: T [] Int -> (Int, T Int)
histogramDiscreteArray 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 -> T (i, Int)
attachOne (T Int -> [(Int, Int)]) -> T Int -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ T [] Int -> T Int
forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten 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), Array Int Int -> T Int
forall i e. Array i e -> [e]
Array.elems Array Int Int
hist)
histogramLinearArray :: RealField.C y => NonEmpty.T Sig.T y -> (Int, Sig.T y)
histogramLinearArray :: forall y. C y => T [] y -> (Int, T y)
histogramLinearArray (NonEmpty.Cons y
x []) = (y -> Int
forall b. C b => y -> b
forall a b. (C a, C b) => a -> b
floor y
x, [])
histogramLinearArray 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), Array Int y -> [y]
forall i e. Array i e -> [e]
Array.elems Array Int y
hist)
histogramDiscreteIntMap :: NonEmpty.T Sig.T Int -> (Int, Sig.T Int)
histogramDiscreteIntMap :: T [] Int -> (Int, T Int)
histogramDiscreteIntMap 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 -> T (i, Int)
attachOne (T Int -> [(Int, Int)]) -> T Int -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ T [] Int -> T Int
forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten 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
fHead Int -> T Int -> T Int
forall a. a -> [a] -> [a]
:
[T Int] -> T Int
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (((Int, Int) -> (Int, Int) -> T Int)
-> [(Int, Int)] -> [(Int, Int)] -> [T Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\(Int
i0,Int
_) (Int
i1,Int
f1) -> Int -> Int -> T 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 T Int -> T Int -> T Int
forall a. [a] -> [a] -> [a]
++ [Int
f1])
[(Int, Int)]
fAll [(Int, Int)]
fs))
histogramLinearIntMap :: RealField.C y => NonEmpty.T Sig.T y -> (Int, Sig.T y)
histogramLinearIntMap :: forall y. C y => T [] y -> (Int, T y)
histogramLinearIntMap (NonEmpty.Cons y
x []) = (y -> Int
forall b. C b => y -> b
forall a b. (C a, C b) => a -> b
floor y
x, [])
histogramLinearIntMap 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)
(Int
startKey:T Int
_, [y]
elems) = [(Int, y)] -> (T 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]
elems)
histogramIntMap :: (RealField.C y) => y -> NonEmpty.T 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 (f :: * -> *) y. (Functor f, C y) => y -> f y -> f Int
quantize y
binsPerUnit
quantize :: (Functor f, RealField.C y) => y -> f y -> f Int
quantize :: forall (f :: * -> *) y. (Functor f, C y) => y -> f y -> f Int
quantize y
binsPerUnit = (y -> Int) -> f y -> f Int
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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
*))
attachOne :: Sig.T i -> Sig.T (i,Int)
attachOne :: forall i. T i -> T (i, Int)
attachOne = (i -> (i, Int)) -> [i] -> [(i, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\i
i -> (i
i,Int
forall a. C a => a
one))
meanValues :: RealField.C y => NonEmpty.T Sig.T y -> [(Int,y)]
meanValues :: forall y. C y => T [] y -> [(Int, y)]
meanValues = ((y, y) -> [(Int, y)]) -> T (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)]
spread (T (y, y) -> [(Int, y)])
-> (T [] y -> T (y, y)) -> T [] y -> [(Int, y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y -> y -> (y, y)) -> T [] y -> T (y, y)
forall (f :: * -> *) a b.
Traversable f =>
(a -> a -> b) -> T f a -> f b
NonEmpty.mapAdjacent (,)
spread :: RealField.C y => (y,y) -> [(Int,y)]
spread :: forall y. C y => (y, y) -> [(Int, y)]
spread (y, y)
lr0 =
let (y
l,y
r) = (y, y) -> (y, y)
forall a. Ord a => (a, a) -> (a, a)
sortPair (y, y)
lr0
(Int
li,y
lf) = y -> (Int, y)
forall b. C b => y -> (b, y)
forall a b. (C a, C b) => a -> (b, a)
splitFraction y
l
(Int
ri,y
rf) = y -> (Int, y)
forall b. C b => y -> (b, y)
forall a b. (C a, C b) => a -> (b, a)
splitFraction y
r
k :: y
k = y -> y
forall a. C a => a -> a
recip (y
ry -> y -> y
forall a. C a => a -> a -> a
-y
l)
nodes :: [(Int, y)]
nodes =
(Int
li,y
ky -> y -> y
forall a. C a => a -> a -> a
*(y
1y -> y -> y
forall a. C a => a -> a -> a
-y
lf)) (Int, y) -> [(Int, y)] -> [(Int, y)]
forall a. a -> [a] -> [a]
:
T Int -> [y] -> [(Int, y)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
liInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1 ..] (Int -> y -> [y]
forall a. Int -> a -> [a]
replicate (Int
riInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
liInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) y
k) [(Int, y)] -> [(Int, y)] -> [(Int, y)]
forall a. [a] -> [a] -> [a]
++
(Int
ri, y
ky -> y -> y
forall a. C a => a -> a -> a
*y
rf) (Int, y) -> [(Int, y)] -> [(Int, y)]
forall a. a -> [a] -> [a]
:
[]
in if Int
liInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
ri
then [(Int
li,y
forall a. C a => a
one)]
else [(Int, y)]
nodes
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
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 => [a] -> a
sum ((y -> y -> y) -> T y -> T y -> T y
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith y -> y -> y
forall a. C a => a -> a -> a
(*) T y
xs T y
ys)
centroid :: Field.C y => Sig.T y -> y
centroid :: forall y. C y => T y -> y
centroid 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 => [a] -> a
sum T y
xs
centroidAlt :: Field.C y => Sig.T y -> y
centroidAlt :: forall y. C y => T y -> y
centroidAlt T y
xs =
T y -> y
forall a. C a => [a] -> a
sum ((y -> y -> y) -> y -> T y -> T y
forall a b. (a -> b -> b) -> b -> [a] -> [b]
scanr y -> y -> y
forall a. C a => a -> a -> a
(+) y
forall a. C a => a
zero (T y -> T y
forall a. HasCallStack => [a] -> [a]
tail T y
xs)) y -> y -> y
forall a. C a => a -> a -> a
/ T y -> y
forall a. C a => [a] -> a
sum T y
xs
firstMoment :: Ring.C y => Sig.T y -> y
firstMoment :: forall y. C y => T y -> y
firstMoment =
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 -> [a]
iterate (y
forall a. C a => a
oney -> y -> y
forall a. C a => a -> a -> a
+) y
forall a. C a => a
zero)
average :: Field.C y => Sig.T y -> y
average :: forall y. C y => T y -> y
average T y
x =
T y -> y
forall a. C a => [a] -> a
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. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length T y
x)
rectify :: Absolute.C y => Sig.T y -> Sig.T y
rectify :: forall y. C y => T y -> T y
rectify = (y -> y) -> [y] -> [y]
forall a b. (a -> b) -> [a] -> [b]
map y -> y
forall a. C a => a -> a
abs
zeros :: (Ord y, Ring.C y) => Sig.T y -> Sig.T Bool
zeros :: forall y. (Ord y, C y) => T y -> T Bool
zeros T y
xs =
let signs :: T Bool
signs = (y -> Bool) -> T y -> T Bool
forall a b. (a -> b) -> [a] -> [b]
map (y -> y -> Bool
forall a. Ord a => a -> a -> Bool
>=y
forall a. C a => a
zero) T y
xs
in (Bool -> Bool -> Bool) -> T Bool -> T Bool -> T Bool
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(/=) T Bool
signs (T Bool -> T Bool
forall a. HasCallStack => [a] -> [a]
tail T Bool
signs)
data BinaryLevel = Low | High
deriving (BinaryLevel -> BinaryLevel -> Bool
(BinaryLevel -> BinaryLevel -> Bool)
-> (BinaryLevel -> BinaryLevel -> Bool) -> Eq BinaryLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinaryLevel -> BinaryLevel -> Bool
== :: BinaryLevel -> BinaryLevel -> Bool
$c/= :: BinaryLevel -> BinaryLevel -> Bool
/= :: BinaryLevel -> BinaryLevel -> Bool
Eq, Int -> BinaryLevel -> ShowS
[BinaryLevel] -> ShowS
BinaryLevel -> [Char]
(Int -> BinaryLevel -> ShowS)
-> (BinaryLevel -> [Char])
-> ([BinaryLevel] -> ShowS)
-> Show BinaryLevel
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinaryLevel -> ShowS
showsPrec :: Int -> BinaryLevel -> ShowS
$cshow :: BinaryLevel -> [Char]
show :: BinaryLevel -> [Char]
$cshowList :: [BinaryLevel] -> ShowS
showList :: [BinaryLevel] -> ShowS
Show, Int -> BinaryLevel
BinaryLevel -> Int
BinaryLevel -> [BinaryLevel]
BinaryLevel -> BinaryLevel
BinaryLevel -> BinaryLevel -> [BinaryLevel]
BinaryLevel -> BinaryLevel -> BinaryLevel -> [BinaryLevel]
(BinaryLevel -> BinaryLevel)
-> (BinaryLevel -> BinaryLevel)
-> (Int -> BinaryLevel)
-> (BinaryLevel -> Int)
-> (BinaryLevel -> [BinaryLevel])
-> (BinaryLevel -> BinaryLevel -> [BinaryLevel])
-> (BinaryLevel -> BinaryLevel -> [BinaryLevel])
-> (BinaryLevel -> BinaryLevel -> BinaryLevel -> [BinaryLevel])
-> Enum BinaryLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BinaryLevel -> BinaryLevel
succ :: BinaryLevel -> BinaryLevel
$cpred :: BinaryLevel -> BinaryLevel
pred :: BinaryLevel -> BinaryLevel
$ctoEnum :: Int -> BinaryLevel
toEnum :: Int -> BinaryLevel
$cfromEnum :: BinaryLevel -> Int
fromEnum :: BinaryLevel -> Int
$cenumFrom :: BinaryLevel -> [BinaryLevel]
enumFrom :: BinaryLevel -> [BinaryLevel]
$cenumFromThen :: BinaryLevel -> BinaryLevel -> [BinaryLevel]
enumFromThen :: BinaryLevel -> BinaryLevel -> [BinaryLevel]
$cenumFromTo :: BinaryLevel -> BinaryLevel -> [BinaryLevel]
enumFromTo :: BinaryLevel -> BinaryLevel -> [BinaryLevel]
$cenumFromThenTo :: BinaryLevel -> BinaryLevel -> BinaryLevel -> [BinaryLevel]
enumFromThenTo :: BinaryLevel -> BinaryLevel -> BinaryLevel -> [BinaryLevel]
Enum)
binaryLevelFromBool :: Bool -> BinaryLevel
binaryLevelFromBool :: Bool -> BinaryLevel
binaryLevelFromBool Bool
False = BinaryLevel
Low
binaryLevelFromBool Bool
True = BinaryLevel
High
binaryLevelToNumber :: Ring.C a => BinaryLevel -> a
binaryLevelToNumber :: forall a. C a => BinaryLevel -> a
binaryLevelToNumber BinaryLevel
Low = a -> a
forall a. C a => a -> a
negate a
forall a. C a => a
one
binaryLevelToNumber BinaryLevel
High = a
forall a. C a => a
one
flipFlopHysteresis :: (Ord y) =>
(y,y) -> BinaryLevel -> Sig.T y -> Sig.T BinaryLevel
flipFlopHysteresis :: forall y. Ord y => (y, y) -> BinaryLevel -> T y -> [BinaryLevel]
flipFlopHysteresis (y, y)
bnds = (BinaryLevel -> y -> BinaryLevel)
-> BinaryLevel -> [y] -> [BinaryLevel]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl ((y, y) -> BinaryLevel -> y -> BinaryLevel
forall a. Ord a => (a, a) -> BinaryLevel -> a -> BinaryLevel
flipFlopHysteresisStep (y, y)
bnds)
flipFlopHysteresisStep :: Ord a => (a, a) -> BinaryLevel -> a -> BinaryLevel
flipFlopHysteresisStep :: forall a. Ord a => (a, a) -> BinaryLevel -> a -> BinaryLevel
flipFlopHysteresisStep (a
lower,a
upper) =
\BinaryLevel
state a
x ->
Bool -> BinaryLevel
binaryLevelFromBool (Bool -> BinaryLevel) -> Bool -> BinaryLevel
forall a b. (a -> b) -> a -> b
$
case BinaryLevel
state of
BinaryLevel
High -> Bool -> Bool
not(a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
lower)
BinaryLevel
Low -> a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
upper
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 y] -> T y
forall a b. (a -> b) -> [a] -> [b]
map (T y -> T y -> y
forall y. C y => T y -> T y -> y
scalarProduct T y
xs) ([T y] -> T y) -> [T y] -> T y
forall a b. (a -> b) -> a -> b
$
(y -> T y) -> T y -> [T y]
forall a b. (a -> b) -> [a] -> [b]
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 y]) -> T y -> [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
binarySign ::
(Ord y, Additive.C y) => Sig.T y -> Sig.T BinaryLevel
binarySign :: forall y. (Ord y, C y) => T y -> [BinaryLevel]
binarySign =
(y -> BinaryLevel) -> [y] -> [BinaryLevel]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> BinaryLevel
binaryLevelFromBool (Bool -> BinaryLevel) -> (y -> Bool) -> y -> BinaryLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y
forall a. C a => a
zero y -> y -> Bool
forall a. Ord a => a -> a -> Bool
<=))
deltaSigmaModulation ::
RealRing.C y => Sig.T y -> Sig.T BinaryLevel
deltaSigmaModulation :: forall y. C y => T y -> [BinaryLevel]
deltaSigmaModulation T y
x =
let y :: [BinaryLevel]
y = T y -> [BinaryLevel]
forall y. (Ord y, C y) => T y -> [BinaryLevel]
binarySign (T y -> T y
forall v. C v => T v -> T v
Integration.run (T y
x T y -> T y -> T y
forall a. C a => a -> a -> a
- (y
forall a. C a => a
zero y -> T y -> T y
forall a. a -> [a] -> [a]
: (BinaryLevel -> y) -> [BinaryLevel] -> T y
forall a b. (a -> b) -> [a] -> [b]
map BinaryLevel -> y
forall a. C a => BinaryLevel -> a
binaryLevelToNumber [BinaryLevel]
y)))
in [BinaryLevel]
y
deltaSigmaModulationPositive ::
RealRing.C y => y -> Sig.T y -> Sig.T y
deltaSigmaModulationPositive :: forall y. C y => y -> T y -> T y
deltaSigmaModulationPositive y
threshold T y
x =
let y :: T y
y =
(y -> y) -> T y -> T y
forall a b. (a -> b) -> [a] -> [b]
map (\y
xi -> if y
xiy -> y -> Bool
forall a. Ord a => a -> a -> Bool
>=y
threshold then y
threshold else y
forall a. C a => a
zero) (T y -> T y) -> T y -> T y
forall a b. (a -> b) -> a -> b
$
T y -> T y
forall v. C v => T v -> T v
Integration.run (T y
x T y -> T y -> T y
forall a. C a => a -> a -> a
- (y
forall a. C a => a
zeroy -> T y -> T y
forall a. a -> [a] -> [a]
:T y
y))
in T y
y