[Haskell-cafe] TraverseAccum: an effectful accumulating map.

[Florent BALESTRIERI]

Hello fellow haskellers. This message is a valid literate haskell
file. I ran it with ghc 6.10.1

> module TraverseAccum where
> import Control.Applicative
> import Data.Traversable

A year ago, I read "Why Attribute Grammars Matter". In it we found a
function on lists wich combined three traversals into one to compute the
differences to the average:

> avg_diff_list :: [Double] -> [Double]
> avg_diff_list xs =
>   let nil = const (0,0.0,[])
>       cons x f mean =
>         let (n,s,ds) = f mean
>         in (n+1,s+x, (x - mean) : ds)
>       (n,s,ds) = foldr cons nil xs (s/n)
>   in ds

Then I found "Applicative programming with effects" which abstracted the
notions of traversal and folding.

We can try and generalize avg_diff_list to work over any Traversable data
structure. Here is a possible version with two traversals:

> avg_diff' :: (Traversable t, Fractional f)
>             => t f -> t f
> avg_diff' t =
>   let start = (0,0.0)
>       step (n,s) x = ((n+1, s+x), \mean -> x - mean)
>       ((n,s), diffs) = mapAccumL step start t
>   in sequenceA diffs (s/n)

But we can do better with only a single traversal. The idea is to
define a function traverseAccumL which does the work of mapAccumL but with
an effectful map. (mapM)

The definition of mapAccumL uses a StateL applicative functor whereas
traverseAccumL uses a StateL monad transformer.

First a few definitions.

> -- left-to-right state transformer
> newtype StateLT m s a = StateLT { runStateLT :: s -> m (s, a) }

> instance Functor m => Functor (StateLT m s) where
>   fmap f (StateLT k) = StateLT $ \ s -> fmap f <$> k s

> instance (Functor m, Monad m) => Applicative (StateLT m s) where
>    pure x = StateLT (\ s -> return (s, x))
>    StateLT kf <*> StateLT kv = StateLT kfv
>      where kfv s = do (s', f) <- kf s
>                       (s'', v) <- kv s'
>                       return (s'', f v)

Incidently, I always wondered why Monad wasn't a subclass of Functor.

> traverseAccumL :: ( Traversable t, Functor m, Monad m)
>                   => (a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
> traverseAccumL f s t = runStateLT (traverse (StateLT . flip f) t) s

I could have done without StateLT but the signature would have been
different:
traverseAccumL :: (Traversable t, Monad m)
                  => (a -> b -> m (c, a)) -> a -> t b -> m (t c, a)
traverseAccumL f s t = runStateT (mapM (StateT . flip f) t) s

Now the definition of avg_diff calls traverseAccumL with the reader monad

> avg_diff :: (Traversable t, Fractional f)
>             => t f -> t f
> avg_diff t =
>   let start = (0,0.0)
>       step (n,s) x mean = ((n+1, s+x), x - mean)
>       ((n,s), diffs) = traverseAccumL step start t (s/n)
>   in diffs

The dual definition traverseAccumR is almost the same. The only
difference lies in the definition of <*>

    StateRT kf <*> StateRT kv = StateRT kfv
      where kfv s = do (s', v) <- kv s
                       (s'', f) <- kf s'
                       return (s'', f v)

> -- right-to-left state transformer
> newtype StateRT m s a = StateRT { runStateRT :: s -> m (s, a) }
>
> instance Functor f => Functor (StateRT f s) where
>   fmap f (StateRT k) = StateRT $ \ s -> fmap f <$> k s
>
> instance (Functor m, Monad m) => Applicative (StateRT m s) where
>    pure x = StateRT (\ s -> return (s, x))
>    StateRT kf <*> StateRT kv = StateRT kfv
>      where kfv s = do (s', v) <- kv s
>                       (s'', f) <- kf s'
>                       return (s'', f v)
>
> traverseAccumR :: ( Traversable t, Functor m, Monad m)
>                   => (a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
> traverseAccumR f s t = runStateRT (traverse (StateRT . flip f) t) s

-- Florent B.