module LambdaSound.Sampling (sampleSound, sampleSoundRaw, unsampleSound, unsampleSoundWithHz) where
import Data.Coerce (coerce)
import Data.Massiv.Array qualified as M
import Data.Massiv.Array.Unsafe qualified as MU
import LambdaSound.Sound
import LambdaSound.Sound.ComputeSound (sampleComputeSound)
import LambdaSound.Sound.Types (makeSamplingInfo)
sampleSoundRaw :: Hz -> Sound T Pulse -> IO (M.Vector M.S Pulse)
sampleSoundRaw :: Hz -> Sound 'T Pulse -> IO (Vector S Pulse)
sampleSoundRaw Hz
hz (TimedSound Duration
duration ComputeSound Pulse
msc) = do
let sr :: SamplingInfo
sr = Hz -> Duration -> SamplingInfo
makeSamplingInfo Hz
hz Duration
duration
SamplingInfo -> ComputeSound Pulse -> IO (Vector S Pulse)
sampleComputeSound SamplingInfo
sr ComputeSound Pulse
msc
sampleSound :: Hz -> Sound T Pulse -> IO (M.Vector M.S Pulse)
sampleSound :: Hz -> Sound 'T Pulse -> IO (Vector S Pulse)
sampleSound Hz
hz Sound 'T Pulse
sound =
Array D Ix1 Pulse -> Vector S Pulse
forall r ix e r'.
(Manifest r e, Load r' ix e) =>
Array r' ix e -> Array r ix e
M.compute (Array D Ix1 Pulse -> Vector S Pulse)
-> (Vector S Pulse -> Array D Ix1 Pulse)
-> Vector S Pulse
-> Vector S Pulse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector S Pulse -> Array D Ix1 Pulse
forall r. Source r Pulse => Vector r Pulse -> Array D Ix1 Pulse
postProcess (Vector S Pulse -> Vector S Pulse)
-> IO (Vector S Pulse) -> IO (Vector S Pulse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Hz -> Sound 'T Pulse -> IO (Vector S Pulse)
sampleSoundRaw Hz
hz Sound 'T Pulse
sound
postProcess :: (M.Source r Pulse) => M.Vector r Pulse -> M.Vector M.D Pulse
postProcess :: forall r. Source r Pulse => Vector r Pulse -> Array D Ix1 Pulse
postProcess = Vector r Pulse -> Array D Ix1 Pulse
forall r. Source r Pulse => Vector r Pulse -> Array D Ix1 Pulse
compressDynamically
compressDynamically :: (M.Source r Pulse) => M.Vector r Pulse -> M.Vector M.D Pulse
compressDynamically :: forall r. Source r Pulse => Vector r Pulse -> Array D Ix1 Pulse
compressDynamically Vector r Pulse
signal = (Pulse -> Pulse) -> Vector r Pulse -> Array D Ix1 Pulse
forall ix r e' e.
(Index ix, Source r e') =>
(e' -> e) -> Array r ix e' -> Array D ix e
M.map (Pulse -> Pulse
scaleToMax (Pulse -> Pulse) -> (Pulse -> Pulse) -> Pulse -> Pulse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pulse -> Pulse
sigmoid) Vector r Pulse
signal
where
scaleToMax :: Pulse -> Pulse
scaleToMax Pulse
x = (Pulse
1 Pulse -> Pulse -> Pulse
forall a. Fractional a => a -> a -> a
/ Pulse -> Pulse
sigmoid Pulse
maxPulse) Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
* Pulse
x
sigmoid :: Pulse -> Pulse
sigmoid Pulse
x = Pulse
2 Pulse -> Pulse -> Pulse
forall a. Fractional a => a -> a -> a
/ (Pulse
1 Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
+ Pulse -> Pulse
forall a. Floating a => a -> a
exp (Pulse
g Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
* (-Pulse
x))) Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
- Pulse
1
g :: Pulse
g = Pulse -> Pulse -> Pulse
forall a. Floating a => a -> a -> a
logBase (Pulse
2 Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
- Pulse
factor) Pulse
factor Pulse -> Pulse -> Pulse
forall a. Fractional a => a -> a -> a
/ (-Pulse
maxPulse)
maxPulse :: Pulse
maxPulse = Array D Ix1 Pulse -> Pulse
forall r ix e.
(HasCallStack, Shape r ix, Source r e, Ord e) =>
Array r ix e -> e
M.maximum' (Array D Ix1 Pulse -> Pulse) -> Array D Ix1 Pulse -> Pulse
forall a b. (a -> b) -> a -> b
$ (Pulse -> Pulse) -> Vector r Pulse -> Array D Ix1 Pulse
forall ix r e' e.
(Index ix, Source r e') =>
(e' -> e) -> Array r ix e' -> Array D ix e
M.map Pulse -> Pulse
forall a. Num a => a -> a
abs Vector r Pulse
signal
factor :: Pulse
factor = Pulse
0.8
unsampleSound :: (M.Source r Pulse) => M.Vector r Pulse -> Sound I Pulse
unsampleSound :: forall r. Source r Pulse => Vector r Pulse -> Sound 'I Pulse
unsampleSound Vector r Pulse
samples = (SamplingInfo -> Ix1 -> Pulse) -> Sound 'I Pulse
forall a. (SamplingInfo -> Ix1 -> a) -> Sound 'I a
makeSound ((SamplingInfo -> Ix1 -> Pulse) -> Sound 'I Pulse)
-> (SamplingInfo -> Ix1 -> Pulse) -> Sound 'I Pulse
forall a b. (a -> b) -> a -> b
$ \SamplingInfo
si ->
if Sz Ix1 -> Ix1
forall ix. Sz ix -> ix
M.unSz (Vector r Pulse -> Sz Ix1
forall r ix e. Size r => Array r ix e -> Sz ix
forall ix e. Array r ix e -> Sz ix
M.size Vector r Pulse
samples) Ix1 -> Ix1 -> Bool
forall a. Eq a => a -> a -> Bool
== SamplingInfo
si.samples
then Vector r Pulse -> Ix1 -> Pulse
forall ix. Index ix => Array r ix Pulse -> ix -> Pulse
forall r e ix. (Source r e, Index ix) => Array r ix e -> ix -> e
MU.unsafeIndex Vector r Pulse
samples
else
let Double
scaler :: Double = Ix1 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Sz Ix1 -> Ix1
forall ix. Sz ix -> ix
M.unSz (Sz Ix1 -> Ix1) -> Sz Ix1 -> Ix1
forall a b. (a -> b) -> a -> b
$ Vector r Pulse -> Sz Ix1
forall r ix e. Size r => Array r ix e -> Sz ix
forall ix e. Array r ix e -> Sz ix
M.size Vector r Pulse
samples) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Ix1 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral SamplingInfo
si.samples
in \Ix1
i -> Vector r Pulse -> Ix1 -> Pulse
forall ix. Index ix => Array r ix Pulse -> ix -> Pulse
forall r e ix. (Source r e, Index ix) => Array r ix e -> ix -> e
MU.unsafeIndex Vector r Pulse
samples (Ix1 -> Pulse) -> Ix1 -> Pulse
forall a b. (a -> b) -> a -> b
$ Double -> Ix1
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Ix1 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Ix1
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
scaler)
unsampleSoundWithHz :: (M.Source r Pulse) => Hz -> M.Vector r Pulse -> Sound T Pulse
unsampleSoundWithHz :: forall r. Source r Pulse => Hz -> Vector r Pulse -> Sound 'T Pulse
unsampleSoundWithHz Hz
hz Vector r Pulse
samples = Duration -> Sound 'I Pulse -> Sound 'T Pulse
forall (d :: SoundDuration) a. Duration -> Sound d a -> Sound 'T a
setDuration Duration
d (Sound 'I Pulse -> Sound 'T Pulse)
-> Sound 'I Pulse -> Sound 'T Pulse
forall a b. (a -> b) -> a -> b
$ Vector r Pulse -> Sound 'I Pulse
forall r. Source r Pulse => Vector r Pulse -> Sound 'I Pulse
unsampleSound Vector r Pulse
samples
where
d :: Duration
d = Hz -> Duration
forall a b. Coercible a b => a -> b
coerce (Hz -> Duration) -> Hz -> Duration
forall a b. (a -> b) -> a -> b
$ Ix1 -> Hz
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Sz Ix1 -> Ix1
forall ix. Sz ix -> ix
M.unSz (Sz Ix1 -> Ix1) -> Sz Ix1 -> Ix1
forall a b. (a -> b) -> a -> b
$ Vector r Pulse -> Sz Ix1
forall r ix e. Size r => Array r ix e -> Sz ix
forall ix e. Array r ix e -> Sz ix
M.size Vector r Pulse
samples) Hz -> Hz -> Hz
forall a. Fractional a => a -> a -> a
/ Hz
hz