Search code examples
haskellreactive-programmingarrow-abstraction

Recursive feedback in Karplus-Strong Algo - arrows


I am trying to implement the simplest version of Karplus-Strong algorithm using Euterpea:

schematic of KS algorithm

My code: 0.7 seconds of white noise burst

burst :: AudSF () Double
burst = proc () -> do 
   burstEnv <- envLineSeg [1,1,0,0] [0.7, 0, 9.3] -< ()
   noise <- noiseWhite 42 -< ()
   outA -< burstEnv * noise

problematic part:

karplus :: AudSF Double Double
karplus = proc input -> do 
  rec  filtered <- filterLowPass -< (delayed, 2000)
       delayed <- delayLine 0.7 -< filtered + input      
  outA -< filtered + input

test1 function should create a file of 10 seconds with a few cycles:

test1 = outFile "test1.wav" 10 $ burst >>> karplus

As far as I know the feedback loop should run on and on and on.

The problem is the input is only delayed and filtered once. It's not fed to the loop again.

I suspect that the problem lies in my not understanding lazy evaluation or value passing.


Solution

  • The problem is not lazy evaluation or recursive arrows; rather, it's that filterLowPass doesn't behave nice on burst: it becomes NaN after the burst finishes.

    We can see that by running it e.g. in GHCi:

    λ» take 15 $ drop 30870 $ Control.SF.SF.run (strip $ burst >>> arr (,2000) >>> filterLowPass) $ repeat ()
    [0.17166330080286152,0.27722776378398983,NaN,NaN,NaN,NaN,NaN,NaN,NaN,NaN,NaN,NaN,NaN,NaN,NaN]
    

    I strongly suspect it is because burst itself behaves strangely near its end:

    λ» take 15 $ drop 30870 $ Control.SF.SF.run (strip $ burst) $ repeat ()
    [0.5998949495013488,NaN,0.0,-0.0,-0.0,0.0,-0.0,-0.0,0.0,-0.0,-0.0,-0.0,0.0,-0.0,0.0]
    

    My suggestion is to fix burst so that it doesn't generate a NaN at its end, and then see if that fixes everything. The 0/-0 oscillation is probably harmless.

    Attempt at fixing

    I have no idea about either Euterpea or sound synthesis; however, by using a very short, but non-0 transition time from 1 to 0 for burstEnv, I was able to get rid of the NaNs. By further reducing the length of the burst and the delay line, I think I got something which is close to the desired "string-like" sound:

    burst :: AudSF () Double
    burst = proc () -> do
       burstEnv <- envLineSeg [1,1,0,0] [0.01, 0.000001, 9.3] -< ()
       noise <- noiseWhite 42 -< ()
       outA -< burstEnv * noise
    
    karplus :: AudSF Double Double
    karplus = proc input -> do
        rec delayed <- delayLine 0.01 -< filtered + input
            filtered <- filterLowPass -< (delayed, 2000)
        outA -< filtered + input