{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Basic.Distortion (
clip, logit,
zigZag, sine,
oddChebyshev,
quantize,
powerSigned,
) where
import qualified Algebra.Transcendental as Trans
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 Data.List.HT (mapAdjacent, )
import Data.Ord.HT (limit, )
import NumericPrelude.Numeric
import NumericPrelude.Base
clip :: (RealRing.C a) => a -> a
clip :: forall a. C a => a -> a
clip = (a, a) -> a -> a
forall a. Ord a => (a, a) -> a -> a
limit (a -> a
forall a. C a => a -> a
negate a
forall a. C a => a
one, a
forall a. C a => a
one)
logit :: (Trans.C a) => a -> a
logit :: forall a. C a => a -> a
logit = a -> a
forall a. C a => a -> a
tanh
zigZag :: (RealField.C a) => a -> a
zigZag :: forall a. C a => a -> a
zigZag a
x =
let (Int
n,a
y) = a -> (Int, a)
forall b. C b => a -> (b, a)
forall a b. (C a, C b) => a -> (b, a)
splitFraction ((a
xa -> a -> a
forall a. C a => a -> a -> a
+a
1)a -> a -> a
forall a. C a => a -> a -> a
/a
2)
in if Int -> Bool
forall a. (C a, C a) => a -> Bool
even (Int
n::Int)
then a
2a -> a -> a
forall a. C a => a -> a -> a
*a
y a -> a -> a
forall a. C a => a -> a -> a
- a
1
else a
1 a -> a -> a
forall a. C a => a -> a -> a
- a
2a -> a -> a
forall a. C a => a -> a -> a
*a
y
sine :: (Trans.C a) => a -> a
sine :: forall a. C a => a -> a
sine = a -> a
forall a. C a => a -> a
sin
oddChebyshev :: (Trans.C a) => (Field.C a) => Int -> a -> a
oddChebyshev :: forall a. (C a, C a) => Int -> a -> a
oddChebyshev Int
n a
xn =
let order :: Int
order = Int
2Int -> Int -> Int
forall a. C a => a -> a -> a
*Int
nInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1
x :: a
x = Int -> a -> a
forall a. C a => Int -> a -> a
parityFlip Int
n (a
xn a -> a -> a
forall a. C a => a -> a -> a
/ Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
order)
ys :: [a]
ys = a
1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> a) -> [a] -> [a]
forall a b. (a -> a -> b) -> [a] -> [b]
mapAdjacent (\a
x0 a
x1 -> a
2a -> a -> a
forall a. C a => a -> a -> a
*a
xa -> a -> a
forall a. C a => a -> a -> a
*a
x1 a -> a -> a
forall a. C a => a -> a -> a
- a
x0) [a]
ys
in [a]
ys [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
order
parityFlip :: Ring.C a => Int -> a -> a
parityFlip :: forall a. C a => Int -> a -> a
parityFlip Int
n a
x =
if Int -> Bool
forall a. (C a, C a) => a -> Bool
even Int
n then a
x else -a
x
_swing :: (Trans.C a) => (Field.C a) => Int -> a -> a
_swing :: forall a. (C a, C a) => Int -> a -> a
_swing Int
n a
x =
(a -> a -> a) -> a -> [a] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
forall a. C a => a -> a -> a
(*) a
x
((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map
(\a
ni ->
let x2 :: a
x2 = a
xa -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2
n2 :: a
n2 = a
nia -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2
in (a
x2a -> a -> a
forall a. C a => a -> a -> a
-a
n2)a -> a -> a
forall a. C a => a -> a -> a
/(a
x2a -> a -> a
forall a. C a => a -> a -> a
+a
n2))
(Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ((a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a
1a -> a -> a
forall a. C a => a -> a -> a
+) a
1)))
quantize :: (RealField.C a) => a -> a
quantize :: forall a. C a => a -> a
quantize a
x = Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral (a -> Int
forall b. C b => a -> b
forall a b. (C a, C b) => a -> b
round a
x :: Int)
{-# INLINE powerSigned #-}
powerSigned :: (Absolute.C a, Trans.C a) => a -> a -> a
powerSigned :: forall a. (C a, C a) => a -> a -> a
powerSigned a
p a
x = a -> a
forall a. C a => a -> a
signum a
x a -> a -> a
forall a. C a => a -> a -> a
* a -> a
forall a. C a => a -> a
abs a
x a -> a -> a
forall a. C a => a -> a -> a
** a
p