netwire accum delayed by one

Hey, With this netwire based program: {-# LANGUAGE Arrows #-} import Control.Wire import Data.List mainWire :: WireP () Double mainWire = proc _ -> do accum (+) 0 -< 1 main = do wireLoop mainWire wireLoop :: WireP () Double -> IO () wireLoop w' = do let (mx, w) = stepWireP w' 1.0 () case mx of Left x -> putStrLn $ show mx Right x -> putStrLn $ show mx wireLoop w I get (output): Right 0.0 Right 1.0 Right 2.0 ... Should the output not start with 1.0 (and not 0.0)? The accum should be applied already in the first invocation, should it not? Regards, Nathan

Nathan Hüsken
With this netwire based program:
mainWire = proc _ -> do accum (+) 0 -< 1
[...]
I get (output):
Right 0.0 Right 1.0 Right 2.0 ...
Should the output not start with 1.0 (and not 0.0)? The accum should be applied already in the first invocation, should it not?
Accum is documented to behave like a left scan, which also starts with the initial value. The reason is that for most applications you want the data dependency on the previous instant instead of on the current. Many useful FRP constructs can be (and are) expressed in terms of accum and accumT. Greets, Ertugrul -- Not to be or to be and (not to be or to be and (not to be or to be and (not to be or to be and ... that is the list monad.

On 11/03/2012 03:09 PM, Ertugrul Söylemez wrote:
Nathan Hüsken
wrote: With this netwire based program:
mainWire = proc _ -> do accum (+) 0 -< 1
[...]
I get (output):
Right 0.0 Right 1.0 Right 2.0 ...
Should the output not start with 1.0 (and not 0.0)? The accum should be applied already in the first invocation, should it not?
Accum is documented to behave like a left scan, which also starts with the initial value. The reason is that for most applications you want the data dependency on the previous instant instead of on the current. Many useful FRP constructs can be (and are) expressed in terms of accum and accumT.
While I understand the intention, I often have several accums (or integral which is expressed in terms of accum) chained. For example: speed :: WireP CollisionData Vector speed = accum collide initSpeed where collide = ... position :: WireP CollisionData Vector position = integral_ initPos . speed which delays the output by 2. Maybe there should also be a "non delaying" version of accum and integral? I must admit, I would prefer it to inset delay manually, but that probably just a matter of taste. Reagards, Nathan

Nathan Hüsken
Accum is documented to behave like a left scan, which also starts with the initial value. The reason is that for most applications you want the data dependency on the previous instant instead of on the current. Many useful FRP constructs can be (and are) expressed in terms of accum and accumT.
While I understand the intention, I often have several accums (or integral which is expressed in terms of accum) chained. For example:
speed :: WireP CollisionData Vector speed = accum collide initSpeed where collide = ...
position :: WireP CollisionData Vector position = integral_ initPos . speed
which delays the output by 2. Maybe there should also be a "non delaying" version of accum and integral? I must admit, I would prefer it to inset delay manually, but that probably just a matter of taste.
That's how earlier versions of Netwire worked, where you always needed explicit delays, but that turned out to be very noisy in code. However, I see why you may want to have the non-delaying versions, so I have added and released them as version 4.0.2. Along with the change I also worked around an apparent Haddock bug, which prevented the documentation from being created for GHC 7.6, so now you get Haddocks, too. Greets, Ertugrul -- Not to be or to be and (not to be or to be and (not to be or to be and (not to be or to be and ... that is the list monad.

Thanks! I think there is still a bug in there. accumT1 "turns into" accumT after the first invocation. Regards, Nathan On 11/04/2012 06:22 AM, Ertugrul Söylemez wrote:
Nathan Hüsken
wrote: Accum is documented to behave like a left scan, which also starts with the initial value. The reason is that for most applications you want the data dependency on the previous instant instead of on the current. Many useful FRP constructs can be (and are) expressed in terms of accum and accumT.
While I understand the intention, I often have several accums (or integral which is expressed in terms of accum) chained. For example:
speed :: WireP CollisionData Vector speed = accum collide initSpeed where collide = ...
position :: WireP CollisionData Vector position = integral_ initPos . speed
which delays the output by 2. Maybe there should also be a "non delaying" version of accum and integral? I must admit, I would prefer it to inset delay manually, but that probably just a matter of taste.
That's how earlier versions of Netwire worked, where you always needed explicit delays, but that turned out to be very noisy in code. However, I see why you may want to have the non-delaying versions, so I have added and released them as version 4.0.2. Along with the change I also worked around an apparent Haddock bug, which prevented the documentation from being created for GHC 7.6, so now you get Haddocks, too.
Greets, Ertugrul
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

Nathan Hüsken
I think there is still a bug in there. accumT1 "turns into" accumT after the first invocation.
Damn copy/paste coding. Apparently I paid more attention to the documentation than to the actual code. =) Fixed. Greets, Ertugrul -- Not to be or to be and (not to be or to be and (not to be or to be and (not to be or to be and ... that is the list monad.
participants (2)
-
Ertugrul Söylemez
-
Nathan Hüsken