module Synthesizer.Storable.Cut (
arrange,
addChunkToBuffer,
arrangeEquidist,
arrangeAdaptive,
arrangeList,
) where
import qualified Synthesizer.Storable.Signal as Sig
import qualified Data.StorableVector as SV
import qualified Data.StorableVector.Lazy as SVL
import qualified Data.StorableVector.ST.Strict as SVST
import Foreign.Storable (Storable)
import Control.Monad.ST.Strict (ST, runST, )
import Control.Monad.Trans.State (runState, modify, gets, put, )
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Data.EventList.Relative.TimeMixed as EventListTM
import qualified Data.EventList.Absolute.TimeBody as AbsEventList
import Data.Tuple.HT (mapSnd, )
import qualified Algebra.Additive as Additive
import qualified Number.NonNegative as NonNeg
import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()
{-# INLINE arrange #-}
arrange :: (Storable v, Additive.C v) =>
Sig.ChunkSize
-> EventList.T NonNeg.Int (Sig.T v)
-> Sig.T v
arrange :: forall v. (Storable v, C v) => ChunkSize -> T Int (T v) -> T v
arrange =
forall v. (Storable v, C v) => ChunkSize -> T Int (T v) -> T v
arrangeEquidist
arrangeAdaptive :: (Storable v, Additive.C v) =>
Sig.ChunkSize
-> EventList.T NonNeg.Int (Sig.T v)
-> Sig.T v
arrangeAdaptive :: forall v. (Storable v, C v) => ChunkSize -> T Int (T v) -> T v
arrangeAdaptive ChunkSize
size =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Storable a => Vector a -> Vector a -> Vector a
Sig.append forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> (a, s)
runState forall a. Storable a => Vector a
Sig.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Storable a => [Vector a] -> Vector a
Sig.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T time body -> [time]
EventList.getTimes) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (m :: * -> *) time0 time1 body0 body1.
Monad m =>
(time0 -> m time1)
-> (body0 -> m body1) -> T time0 body0 -> m (T time1 body1)
EventList.mapM
(\Int
timeNN ->
let time :: Int
time = forall a. T a -> a
NonNeg.toNumber Int
timeNN
in do (Vector v
prefix,Vector v
suffix) <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (forall x.
(C x, Storable x) =>
ChunkSize -> Int -> T x -> (T x, T x)
Sig.splitAtPad ChunkSize
size Int
time)
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Vector v
suffix
forall (m :: * -> *) a. Monad m => a -> m a
return Vector v
prefix)
(\Vector v
body ->
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (forall x. (C x, Storable x) => T x -> T x -> T x
Sig.mixSndPattern Vector v
body))
arrangeList :: (Storable v, Additive.C v) =>
Sig.ChunkSize
-> EventList.T NonNeg.Int (Sig.T v)
-> Sig.T v
arrangeList :: forall v. (Storable v, C v) => ChunkSize -> T Int (T v) -> T v
arrangeList ChunkSize
size T Int (T v)
evs =
let xs :: [T v]
xs = forall time body. T time body -> [body]
EventList.getBodies T Int (T v)
evs
in case forall time body. T time body -> [time]
EventList.getTimes T Int (T v)
evs of
Int
t:[Int]
ts -> forall a. Storable a => ChunkSize -> Int -> a -> Vector a
Sig.replicate ChunkSize
size (forall a. T a -> a
NonNeg.toNumber Int
t) forall a. C a => a
zero forall a. Storable a => Vector a -> Vector a -> Vector a
`Sig.append`
forall a. (Storable a, C a) => ChunkSize -> [Int] -> [T a] -> T a
addShiftedMany ChunkSize
size [Int]
ts [T v]
xs
[] -> forall a. Storable a => Vector a
Sig.empty
addShiftedMany :: (Storable a, Additive.C a) =>
Sig.ChunkSize -> [NonNeg.Int] -> [Sig.T a] -> Sig.T a
addShiftedMany :: forall a. (Storable a, C a) => ChunkSize -> [Int] -> [T a] -> T a
addShiftedMany ChunkSize
size [Int]
ds [T a]
xss =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a.
(Storable a, C a) =>
ChunkSize -> Int -> T a -> T a -> T a
addShifted ChunkSize
size)) forall a. Storable a => Vector a
Sig.empty (forall a b. [a] -> [b] -> [(a, b)]
zip ([Int]
dsforall a. [a] -> [a] -> [a]
++[Int
0]) [T a]
xss)
addShifted :: (Storable a, Additive.C a) =>
Sig.ChunkSize -> NonNeg.Int -> Sig.T a -> Sig.T a -> Sig.T a
addShifted :: forall a.
(Storable a, C a) =>
ChunkSize -> Int -> T a -> T a -> T a
addShifted ChunkSize
size Int
delNN T a
px T a
py =
let del :: Int
del = forall a. T a -> a
NonNeg.toNumber Int
delNN
in forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Storable a => Vector a -> Vector a -> Vector a
Sig.append forall a b. (a -> b) -> a -> b
$
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall x. (C x, Storable x) => T x -> T x -> T x
Sig.mixSndPattern T a
py) forall a b. (a -> b) -> a -> b
$
forall x.
(C x, Storable x) =>
ChunkSize -> Int -> T x -> (T x, T x)
Sig.splitAtPad ChunkSize
size Int
del T a
px
{-# INLINE arrangeEquidist #-}
arrangeEquidist :: (Storable v, Additive.C v) =>
Sig.ChunkSize
-> EventList.T NonNeg.Int (Sig.T v)
-> Sig.T v
arrangeEquidist :: forall v. (Storable v, C v) => ChunkSize -> T Int (T v) -> T v
arrangeEquidist (SVL.ChunkSize Int
sz) =
let sznn :: Int
sznn = forall a. (Ord a, C a) => String -> a -> T a
NonNeg.fromNumberMsg String
"arrangeEquidist" Int
sz
go :: [Vector a] -> T Int (Vector a) -> [Vector a]
go [Vector a]
acc T Int (Vector a)
evs =
let (T Int (Vector a)
now,T Int (Vector a)
future) = forall time body.
C time =>
time -> T time body -> (T time body, T time body)
EventListTM.splitAtTime Int
sznn T Int (Vector a)
evs
xs :: [(Int, Vector a)]
xs =
forall a b. T a b -> [(a, b)]
AbsEventList.toPairList forall a b. (a -> b) -> a -> b
$
forall time body. Num time => time -> T time body -> T time body
EventList.toAbsoluteEventList Int
0 forall a b. (a -> b) -> a -> b
$
forall time body a. (T time body -> time -> a) -> T time body -> a
EventListTM.switchTimeR forall a b. a -> b -> a
const T Int (Vector a)
now
(Vector a
chunk,[(Int, Vector a)]
newAcc) =
forall a. (forall s. ST s a) -> a
runST
(do Vector s a
v <- forall e s. Storable e => Int -> e -> ST s (Vector s e)
SVST.new Int
sz forall a. C a => a
zero
[(Int, Vector a)]
newAcc0 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a s.
(Storable a, C a) =>
Vector s a -> Int -> T a -> ST s (Int, T a)
addToBuffer Vector s a
v Int
0) [Vector a]
acc
[(Int, Vector a)]
newAcc1 <-
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Int
i,Vector a
s) -> forall a s.
(Storable a, C a) =>
Vector s a -> Int -> T a -> ST s (Int, T a)
addToBuffer Vector s a
v (forall a. T a -> a
NonNeg.toNumber Int
i) Vector a
s) [(Int, Vector a)]
xs
Vector a
vf <- forall e s. Storable e => Vector s e -> ST s (Vector e)
SVST.freeze Vector s a
v
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector a
vf, [(Int, Vector a)]
newAcc0forall a. [a] -> [a] -> [a]
++[(Int, Vector a)]
newAcc1))
([Int]
ends, [Vector a]
suffixes) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ [(Int, Vector a)]
newAcc
prefix :: Vector a
prefix =
if forall time body. T time body -> Bool
EventList.null T Int (Vector a)
future
then forall a. Storable a => Int -> Vector a -> Vector a
SV.take (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Ord a => a -> a -> a
max Int
0 [Int]
ends) Vector a
chunk
else Vector a
chunk
in if forall a. Vector a -> Bool
SV.null Vector a
prefix
then []
else Vector a
prefix forall a. a -> [a] -> [a]
: [Vector a] -> T Int (Vector a) -> [Vector a]
go (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => Vector a -> Bool
Sig.null) [Vector a]
suffixes) T Int (Vector a)
future
in forall a. Storable a => [Vector a] -> Vector a
Sig.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}.
(C a, Storable a) =>
[Vector a] -> T Int (Vector a) -> [Vector a]
go []
{-# INLINE addToBuffer #-}
addToBuffer :: (Storable a, Additive.C a) =>
SVST.Vector s a -> Int -> Sig.T a -> ST s (Int, Sig.T a)
addToBuffer :: forall a s.
(Storable a, C a) =>
Vector s a -> Int -> T a -> ST s (Int, T a)
addToBuffer Vector s a
v Int
start T a
xs =
let n :: Int
n = forall s e. Vector s e -> Int
SVST.length Vector s a
v
(T a
now,T a
future) = forall a. Storable a => Int -> Vector a -> (Vector a, Vector a)
Sig.splitAt (Int
n forall a. C a => a -> a -> a
Additive.- Int
start) T a
xs
go :: Int -> [Vector a] -> ST s Int
go Int
i [] = forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
go Int
i (Vector a
c:[Vector a]
cs) =
forall a s.
(Storable a, C a) =>
Vector s a -> Int -> Vector a -> ST s ()
unsafeAddChunkToBuffer Vector s a
v Int
i Vector a
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Int -> [Vector a] -> ST s Int
go (Int
i forall a. C a => a -> a -> a
+ forall a. Vector a -> Int
SV.length Vector a
c) [Vector a]
cs
in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) T a
future) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Vector a] -> ST s Int
go Int
start forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [Vector a]
Sig.chunks forall a b. (a -> b) -> a -> b
$ T a
now
{-# INLINE addChunkToBuffer #-}
addChunkToBuffer :: (Storable a, Additive.C a) =>
SVST.Vector s a -> Int -> SV.Vector a -> ST s ()
addChunkToBuffer :: forall a s.
(Storable a, C a) =>
Vector s a -> Int -> Vector a -> ST s ()
addChunkToBuffer Vector s a
v Int
start Vector a
xs =
if Int
start forall a. C a => a -> a -> a
+ forall a. Vector a -> Int
SV.length Vector a
xs forall a. Ord a => a -> a -> Bool
<= forall s e. Vector s e -> Int
SVST.length Vector s a
v
then forall a s.
(Storable a, C a) =>
Vector s a -> Int -> Vector a -> ST s ()
unsafeAddChunkToBuffer Vector s a
v Int
start Vector a
xs
else forall a. HasCallStack => String -> a
error String
"Storable.addChunkToBuffer: chunk too large"
{-# INLINE unsafeAddChunkToBuffer #-}
unsafeAddChunkToBuffer :: (Storable a, Additive.C a) =>
SVST.Vector s a -> Int -> SV.Vector a -> ST s ()
unsafeAddChunkToBuffer :: forall a s.
(Storable a, C a) =>
Vector s a -> Int -> Vector a -> ST s ()
unsafeAddChunkToBuffer Vector s a
v Int
start Vector a
xs =
let go :: Int -> Int -> ST s ()
go Int
i Int
j =
if Int
j forall a. Ord a => a -> a -> Bool
>= forall a. Vector a -> Int
SV.length Vector a
xs
then forall (m :: * -> *) a. Monad m => a -> m a
return ()
else
forall e s. Storable e => Vector s e -> Int -> (e -> e) -> ST s ()
SVST.unsafeModify Vector s a
v Int
i (forall a. Storable a => Vector a -> Int -> a
SV.index Vector a
xs Int
j forall a. C a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Int -> Int -> ST s ()
go (Int
i forall a. C a => a -> a -> a
+ Int
1) (Int
j forall a. C a => a -> a -> a
+ Int
1)
in Int -> Int -> ST s ()
go Int
start Int
0
{-# INLINE _unsafeAddChunkToBufferFoldr #-}
_unsafeAddChunkToBufferFoldr :: (Storable a, Additive.C a) =>
SVST.Vector s a -> Int -> SV.Vector a -> ST s ()
_unsafeAddChunkToBufferFoldr :: forall a s.
(Storable a, C a) =>
Vector s a -> Int -> Vector a -> ST s ()
_unsafeAddChunkToBufferFoldr Vector s a
v Int
start Vector a
xs =
forall a b. Storable a => (a -> b -> b) -> b -> Vector a -> b
SV.foldr
(\a
x Int -> ST s ()
continue Int
i ->
forall e s. Storable e => Vector s e -> Int -> (e -> e) -> ST s ()
SVST.unsafeModify Vector s a
v Int
i (a
x forall a. C a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Int -> ST s ()
continue (forall a. Enum a => a -> a
succ Int
i))
(\Int
_i -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
Vector a
xs Int
start
{-# INLINE _addToBufferFoldr #-}
_addToBufferFoldr :: (Storable a, Additive.C a) =>
SVST.Vector s a -> Int -> Sig.T a -> ST s (Int, Sig.T a)
_addToBufferFoldr :: forall a s.
(Storable a, C a) =>
Vector s a -> Int -> T a -> ST s (Int, T a)
_addToBufferFoldr Vector s a
v Int
start T a
xs =
let n :: Int
n = forall s e. Vector s e -> Int
SVST.length Vector s a
v
(T a
now,T a
future) = forall a. Storable a => Int -> Vector a -> (Vector a, Vector a)
Sig.splitAt (Int
n forall a. C a => a -> a -> a
Additive.- Int
start) T a
xs
in forall b a. Storable b => (b -> a -> a) -> a -> Vector b -> a
Sig.foldr
(\a
x Int -> ST s (Int, T a)
continue Int
i ->
forall e s. Storable e => Vector s e -> Int -> (e -> e) -> ST s ()
SVST.modify Vector s a
v Int
i (a
x forall a. C a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Int -> ST s (Int, T a)
continue (forall a. Enum a => a -> a
succ Int
i))
(\Int
i -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, T a
future))
T a
now Int
start
_addToBufferSwitchL :: (Storable a, Additive.C a) =>
SVST.Vector s a -> Int -> Sig.T a -> ST s (Int, Sig.T a)
_addToBufferSwitchL :: forall a s.
(Storable a, C a) =>
Vector s a -> Int -> T a -> ST s (Int, T a)
_addToBufferSwitchL Vector s a
v Int
start =
let n :: Int
n = forall s e. Vector s e -> Int
SVST.length Vector s a
v
{-# INLINE go #-}
go :: Int -> Vector a -> ST s (Int, Vector a)
go Int
i =
if Int
iforall a. Ord a => a -> a -> Bool
>=Int
n
then forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) Int
i
else
forall a b.
Storable a =>
b -> (a -> Vector a -> b) -> Vector a -> b
Sig.switchL
(forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, forall a. Storable a => Vector a
Sig.empty))
(\a
x Vector a
xs ->
forall e s. Storable e => Vector s e -> Int -> (e -> e) -> ST s ()
SVST.modify Vector s a
v Int
i (a
x forall a. C a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Int -> Vector a -> ST s (Int, Vector a)
go (forall a. Enum a => a -> a
succ Int
i) Vector a
xs)
in Int -> Vector a -> ST s (Int, Vector a)
go Int
start