Well okay, I don't really need the state since it is already in the list... So cleaned up

iterateM n i = 
  fmap (tail . reverse) .
  foldM collectEffect [i] .
  replicate n
  where
    collectEffect xxs@(x:xs) f = fmap (:xxs) (f x)

But I'm sure it can be much simpler (I don't understand Claus' version :-)

On Wed, Apr 8, 2009 at 6:38 PM, Peter Verswyvelen <bugfact@gmail.com> wrote:
Oh, I could have written it in more point free style (with arguments reversed) as

iterateM n i = fmap (reverse . snd) . 
               foldM collectEffect (i,[]) .
               replicate n
  where
    collectEffect (x,rs) f = f x >>= \y -> return (y,y:rs)

and I'm sure collectEffect could also be improved, but I'm still in newbieeee land

On Wed, Apr 8, 2009 at 6:33 PM, Peter Verswyvelen <bugfact@gmail.com> wrote:
I don't think scanl can work here, since the monadic action has to be applied to the result of previous one and will have a side effect, so if you build a list like

[return i, return i >>= f, return i >>= f >>= f, ...]

the first action will do nothing, the second action will have a single side effect, but the third one will have 3 side effects instead of 2, because it operates on the side-effect performed by the second one.

This seems to work (a combination of manual state monad and foldM, I could also have used a state monad transformer I guess)

iterateM n f i = foldM collectEffect (i,[]) (replicate n f) >>= return . reverse . snd
  where
    collectEffect (x,rs) f = f x >>= \y -> return (y,y:rs)

Ugly test:

var = unsafePerformIO $ newIORef 0

inc i = do
x <- readIORef var
let y = x+i
writeIORef var y
return y

results in

*Main> iterateM 10 inc 1
[1,2,4,8,16,32,64,128,256,512]
*Main> iterateM 10 inc 1
[513,1026,2052,4104,8208,16416,32832,65664,131328,262656]

but maybe this is not what you're looking for?








On Wed, Apr 8, 2009 at 5:30 PM, Thomas Davie <tom.davie@gmail.com> wrote:

On 8 Apr 2009, at 17:20, Jonathan Cast wrote:

On Wed, 2009-04-08 at 16:57 +0200, Thomas Davie wrote:
We have two possible definitions of an "iterateM" function:

iterateM 0 _ _ = return []
iterateM n f i = (i:) <$> (iterateM (n-1) f =<< f i)

iterateM n f i = sequence . scanl (>>=) (return i) $ replicate n f

The former uses primitive recursion, and I get the feeling it should
be better written without it.  The latter is quadratic time – it
builds up a list of monadic actions, and then runs them each in turn.

It's also quadratic in invocations of f, no?  If your monad's (>>=)
doesn't object to being left-associated (which is *not* the case for
free monads), then I think

iterateM n f i = foldl (>>=) (return i) $ replicate n f

But this isn't the same function – it only gives back the final result, not the intermediaries.

Bob_______________________________________________