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.