[Haskell-cafe] A challenge
Thomas Davie
tom.davie at gmail.com
Wed Apr 8 13:05:20 EDT 2009
On 8 Apr 2009, at 18:21, Claus Reinke wrote:
> |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
>
> These function are not the same (sequence of scanl? try using print
> in f). Also, I seriously hope you are not looking for this line
> noise:-)
No indeed – that's what I meant about the latter being quadratic – it
runs the action far more times than the other.
>
> iterateM' = (foldr op (const $ return []) .) . replicate
> where f `op` x = uncurry (<$>) . ((:) &&& ((x =<<) . f))
>
> Because if you do, your penance for using it would involve
> demonstrating that this is equivalent (+-1), or not (and do not
> mention my name anywhere near it!-)
ghci tells me this:
Prelude Control.Applicative Control.Arrow> let iterateM' = let f `op`
x = uncurry (<$>) . ((:) &&& ((x=<<) . f)) in (foldr op (const $
return []) .) . replicate
<interactive>:1:92:
Ambiguous type variable `m' in the constraints:
`Monad m' arising from a use of `return' at <interactive>:
1:92-100
`Functor m' arising from a use of `op' at <interactive>:1:80-81
Probable fix: add a type signature that fixes these type
variable(s)
More information about the Haskell-Cafe
mailing list