how to implement mapAccumRM? - haskell

Question

I asked a similar question before (how to implement mapAccumM?).
I need the one which folds from the right as well (mapAccumR):
mapAccumRM :: (Monad m, Traversable t)
=> (a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
Is there a simple implementation for this?

Answer 1

One approach is to define new instances of Traversable that use the ordering you like. For example, for lists, one might simply define a new type:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Control.Applicative
import Data.Traversable
newtype BackwardsList a = BackwardsList [a]
deriving (Eq, Ord, Read, Show, Functor, Foldable)
instance Traversable BackwardsList where
traverse f (BackwardsList xs) = BackwardsList <$> go xs where
go [] = pure []
go (x:xs) = liftA2 (flip (:)) (go xs) (f x)
In ghci, we can see the difference between this and the standard instance:
> runState (traverse (\_ -> modify (+1) >> get) "hello, world!") 0
([1,2,3,4,5,6,7,8,9,10,11,12,13],13)
> runState (traverse (\_ -> modify (+1) >> get) (BackwardsList "hello, world!")) 0
(BackwardsList [13,12,11,10,9,8,7,6,5,4,3,2,1],13)
This approach is fairly simple; however, it requires a new type (and the associated newtype wrapping/unwrapping garbage) for every new traversal order that you are interested in.

Answer 2

One could consider defining a new type class for ordered traversals. Let's see one way this might be done. We'll need a little prelude:
{-# LANGUAGE Rank2Types, TypeFamilies #-}
import Control.Applicative
import Data.Foldable
import Data.Traversable
import Data.Tree
Most Haskell data types can be viewed as fixed-points of polynomial functors; and the functors that they are fixed-points of are good descriptions of the "spine" of the data structure. We'll abuse this idea to give a concrete way to encode the ordering that should be used during traversal. The class itself looks like this:
type Order t = forall f a. Applicative f => Spine t (f a) (f (t a)) -> f (t a)
class OrderedTraversable t where
data Spine t :: * -> * -> *
otraverse :: Applicative f => Order t -> (a -> f b) -> t a -> f (t b)
Notice that the type of otraverse looks just like the type of traverse, except that it now takes an extra ordering argument. The ordering argument is, in a sense, variadic; since different data types have different numbers of values/children at various places in their structure, and the ordering may care about all of them. (Of special interest is here is the technique of using rank-2 types to prevent an ordering from observing "too much" about a data structure: it can't use special facts about a given instance of Applicative or given kind of element to decide how to traverse a spine, only decisions based on the shape of the spine are allowed.) Let's see a simple example, for lists:
instance OrderedTraversable [] where
-- Cute hack: the normal presentation for the spine of a list uses both
-- a `Cons` and a `Nil`; but parametricity says the only thing an
-- `Order []` can do with a `Nil` is `pure []` anyway. So let's just
-- bake that into `otraverse`.
data Spine [] a r = Cons a r
otraverse order f = go where
go [] = pure []
go (x:xs) = order (Cons (f x) (go xs))
Compare with the implementation of Traversable for lists in the standard library (I have taken the liberty of expanding the definition of foldr to make it more closely match the code above):
instance Traversable [] where
traverse f = go where
go [] = pure []
go (x:xs) = (:) <$> f x <*> go xs
As you can see, the primary difference is that we have abstracted which function to use to combine f x and go xs. We can recover the standard Traversable instance with a "head-first" order. There is also a "last-first" order; and these are basically the only two orders that make sense for lists.
headFirst, lastFirst :: Order []
headFirst (Cons fx fxs) = liftA2 (:) fx fxs
lastFirst (Cons fx fxs) = liftA2 (flip (:)) fxs fx
In ghci, we can now see how they differ:
> runState (traverse (\_ -> modify (+1) >> get) "hello, world!") 0
([1,2,3,4,5,6,7,8,9,10,11,12,13],13)
> runState (otraverse headFirst (\_ -> modify (+1) >> get) "hello, world!") 0
([1,2,3,4,5,6,7,8,9,10,11,12,13],13)
> runState (otraverse lastFirst (\_ -> modify (+1) >> get) "hello, world!") 0
([13,12,11,10,9,8,7,6,5,4,3,2,1],13)
To give another example, here is how you might use this class with rose trees:
instance OrderedTraversable Tree where
data Spine Tree a r = SNode a [r]
otraverse order f = go where
go (Node x ts) = order (SNode (f x) (map go ts))
-- two example orders for trees
prefix, postfix :: Order [] -> Order Tree
prefix list (SNode fx fts) = liftA2 Node fx (otraverse list id fts)
postfix list (SNode fx fts) = liftA2 (flip Node) (otraverse list id fts) fx
Note that there are actually infinitely many "good" ordering functions for rose trees; two that are particularly likely to be what you want are included above.