moduleSynthesizer.Storable.CutwhereimportqualifiedSynthesizer.Storable.SignalasSigimportqualifiedData.StorableVectorasSVimportqualifiedData.StorableVector.LazyasSVLimportqualifiedData.StorableVector.ST.StrictasSVSTimportControl.Monad.ST.Strict(ST,runST,)importqualifiedData.EventList.Relative.TimeBodyasEventListimportqualifiedData.EventList.Relative.TimeMixedasEventListTMimportqualifiedData.EventList.Absolute.TimeBodyasAbsEventListimportControl.Monad.Trans.State(runState,modify,gets,put,)-- import Control.Monad (mapM, )importData.Tuple.HT(mapSnd,)-- import qualified Algebra.RealRing as RealRingimportqualifiedAlgebra.AdditiveasAdditiveimportqualifiedNumber.NonNegativeasNonNegimportForeign.Storable(Storable)importNumericPrelude.BaseimportNumericPrelude.Numeric{-# INLINE arrange #-}arrange::(Storablev,Additive.Cv)=>Sig.ChunkSize->EventList.TNonNeg.Int(Sig.Tv){-^ A list of pairs: (relative start time, signal part),
The start time is relative to the start time
of the previous event. -}->Sig.Tv{-^ The mixed signal. -}arrange=arrangeEquidist{- |
Chunk sizes are adapted to the time differences.
Explicit ChunkSize parameter is only required for zero padding.
Since no ST monad is needed, this can be generalized to Generic.Signal.Transform class.
-}arrangeAdaptive::(Storablev,Additive.Cv)=>Sig.ChunkSize->EventList.TNonNeg.Int(Sig.Tv){-^ A list of pairs: (relative start time, signal part),
The start time is relative to the start time
of the previous event. -}->Sig.Tv{-^ The mixed signal. -}arrangeAdaptivesize=uncurrySig.append.fliprunStateSig.empty.fmap(Sig.concat.EventList.getTimes).EventList.mapM(\timeNN->lettime=NonNeg.toNumbertimeNNindo(prefix,suffix)<-gets(Sig.splitAtPadsizetime)putsuffixreturnprefix)(\body->modify(Sig.mixSndPatternbody)){- |
This function also uses the time differences as chunk sizes,
but may occasionally use smaller chunk sizes due to the chunk structure
of an input signal until the next signal starts.
-}arrangeList::(Storablev,Additive.Cv)=>Sig.ChunkSize->EventList.TNonNeg.Int(Sig.Tv){-^ A list of pairs: (relative start time, signal part),
The start time is relative to the start time
of the previous event. -}->Sig.Tv{-^ The mixed signal. -}arrangeListsizeevs=letxs=EventList.getBodiesevsincaseEventList.getTimesevsoft:ts->Sig.replicatesize(NonNeg.toNumbert)zero`Sig.append`addShiftedManysizetsxs[]->Sig.emptyaddShiftedMany::(Storablea,Additive.Ca)=>Sig.ChunkSize->[NonNeg.Int]->[Sig.Ta]->Sig.TaaddShiftedManysizedsxss=foldr(uncurry(addShiftedsize))Sig.empty(zip(ds++[0])xss){-
It is crucial that 'mix' uses the chunk size structure of the second operand.
This way we avoid unnecessary and even infinite look-ahead.
-}addShifted::(Storablea,Additive.Ca)=>Sig.ChunkSize->NonNeg.Int->Sig.Ta->Sig.Ta->Sig.TaaddShiftedsizedelNNpxpy=letdel=NonNeg.toNumberdelNNinuncurrySig.append$mapSnd(flipSig.mixSndPatternpy)$Sig.splitAtPadsizedelpx{-
arrangeEquidist (Sig.chunkSize 2) (EventList.fromPairList [(10, SVL.pack SVL.defaultChunkSize [1..8::Double]), (2, SVL.pack (Sig.chunkSize 2) $ [4,3,2,1::Double] ++ undefined)])
-}{- |
The result is a Lazy StorableVector with chunks of the given size.
-}{-# INLINE arrangeEquidist #-}arrangeEquidist::(Storablev,Additive.Cv)=>Sig.ChunkSize->EventList.TNonNeg.Int(Sig.Tv){-^ A list of pairs: (relative start time, signal part),
The start time is relative to the start time
of the previous event. -}->Sig.Tv{-^ The mixed signal. -}arrangeEquidist(SVL.ChunkSizesz)=letsznn=NonNeg.fromNumberMsg"arrangeEquidist"szgoaccevs=let(now,future)=EventListTM.splitAtTimesznnevsxs=AbsEventList.toPairList$EventList.toAbsoluteEventList0$EventListTM.switchTimeRconstnow(chunk,newAcc)=runST(dov<-SVST.newszzeronewAcc0<-mapM(addToBufferv0)acc-- newAcc1 <- AbsEventList.mapM (addToBuffer v) xsnewAcc1<-mapM(\(i,s)->addToBufferv(NonNeg.toNumberi)s)xsvf<-SVST.freezevreturn(vf,newAcc0++newAcc1))(ends,suffixes)=unzip$newAccprefix={- if there are more events to come,
we must pad with zeros -}ifEventList.nullfuturethenSV.take(foldlmax0ends)chunkelsechunkinifSV.nullprefixthen[]elseprefix:go(filter(not.Sig.null)suffixes)futureinSig.fromChunks.go[]{-
{-# INLINE addToBuffer #-}
addToBuffer :: (Storable a, Additive.C a) =>
SVST.Vector s a -> Int -> Sig.T a -> ST s (Int, Sig.T a)
addToBuffer v start =
let n = SVST.length v
go i [] = return (i, [])
go i (c:cs) =
let end = i + SV.length c
in addChunkToBuffer v i c >>
if end<n
then go end cs
else return (n, SV.drop (end-n) c : cs)
in fmap (mapSnd SigSt.fromChunks) . go start . SigSt.chunks
addChunkToBuffer :: (Storable a, Additive.C a) =>
SVST.Vector s a -> Int -> SV.Vector a -> ST s ()
addChunkToBuffer v start xs =
let n = SVST.length v
in SV.foldr
(\x continue i ->
SVST.modify v i (x Additive.+) >>
continue (succ i))
(\_i -> return ())
(Sig.take (n Additive.- start) xs)
start
-}{-# INLINE addToBuffer #-}addToBuffer::(Storablea,Additive.Ca)=>SVST.Vectorsa->Int->Sig.Ta->STs(Int,Sig.Ta)addToBuffervstartxs=letn=SVST.lengthv(now,future)=Sig.splitAt(nAdditive.-start)xsgoi[]=returnigoi(c:cs)=addChunkToBuffervic>>go(iAdditive.+SV.lengthc)csinfmap(flip(,)future).gostart.Sig.chunks$now{- | chunk must fit into the buffer -}{- This implementation will be faster as long as 'SV.foldr' is inefficient. -}{-# INLINE addChunkToBuffer #-}addChunkToBuffer::(Storablea,Additive.Ca)=>SVST.Vectorsa->Int->SV.Vectora->STs()addChunkToBuffervstartxs=letgoij=ifj>=SV.lengthxsthenreturn()elseSVST.unsafeModifyvi(SV.indexxsjAdditive.+)>>go(iAdditive.+1)(jAdditive.+1)ingostart0{- | chunk must fit into the buffer -}{-# INLINE addChunkToBufferFoldr #-}addChunkToBufferFoldr::(Storablea,Additive.Ca)=>SVST.Vectorsa->Int->SV.Vectora->STs()addChunkToBufferFoldrvstartxs=SV.foldr(\xcontinuei->SVST.unsafeModifyvi(xAdditive.+)>>continue(succi))(\_i->return())xsstart-- most elegant solution, but slow because StorableVector.foldr is slow{-# INLINE addToBufferFoldr #-}addToBufferFoldr::(Storablea,Additive.Ca)=>SVST.Vectorsa->Int->Sig.Ta->STs(Int,Sig.Ta)addToBufferFoldrvstartxs=letn=SVST.lengthv(now,future)=Sig.splitAt(nAdditive.-start)xsinSig.foldr(\xcontinuei->SVST.modifyvi(xAdditive.+)>>continue(succi))(\i->return(i,future))nowstart{-
Using @Sig.switchL@ in an inner loop
is slower than using @Sig.foldr@.
Using a StorableVectorPointer would be faster,
but I think still slower than @foldr@.
-}addToBufferSwitchL::(Storablea,Additive.Ca)=>SVST.Vectorsa->Int->Sig.Ta->STs(Int,Sig.Ta)addToBufferSwitchLvstart=letn=SVST.lengthv{-# INLINE go #-}goi=ifi>=nthenreturn.(,)ielseSig.switchL(return(i,Sig.empty))(\xxs->SVST.modifyvi(xAdditive.+)>>go(succi)xs)ingostart