RamdaJS reduceBy() in Haskell using recursion-schemes

Question

I have the following code using recursion-schemes library:

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
import Data.Functor.Foldable
import Data.Maybe

import qualified Data.Map as M

reduceBy valueAlgebra keyFn = cata $ fooAlgebra valueAlgebra keyFn

fooAlgebra
  :: Ord k =>
     (ListF t a -> a) -> (t -> k) -> ListF t (M.Map k a) -> M.Map k a   
fooAlgebra valueAlgebra keyFn = \case
    Nil -> M.empty
    Cons elt acc -> M.alter 
         (Just . (valueAlgebra . Cons elt) . fromMaybe (valueAlgebra Nil)) 
         (keyFn elt)
         acc

Use as let countBy = reduceBy (\case Nil -> 0 ; Cons a b -> succ b) id in countBy [42,5,5,8,8,8]. The code mimics http://ramdajs.com/docs/#reduceBy

Is there a better way to implement reduceBy using recursion-schemes? The alter arguments seem fragile, and is cata really appropriate there? I heard that some things are implementable both as ana and cata.

Answer 1

My own attempt based on all the advices so far:

type ListAlgebra a b = ListF a b -> b

reduceBy :: Ord k => ListAlgebra t b -> (t -> k) -> [t] -> M.Map k b
reduceBy valueAlgebra keyFn x = cata valueAlgebra <$> cata groupAlgebra x where
    groupAlgebra = \case
        Nil -> M.empty
        Cons elt acc -> M.alter (Just . maybe [elt] (elt:)) (keyFn elt) acc

Another direction of attack is to notice that keyFn can be factored out of the groupAlgebra, so it becomes groupAlgebra' :: ListAlgebra (k, v) (M.Map k [v]). In this form it's exactly an embed, albeit somewhat exotic:

newtype XMap k v = XMap { unXMap :: M.Map k [v] }
type instance Base (XMap k v) = ListF (k, v)
instance Ord k => Corecursive (XMap k v) where
    embed = \case
        Nil -> XMap M.empty
        Cons (key,elt) acc -> XMap $ M.alter (Just . maybe [elt] (elt:)) key $ unXMap acc

No fixpoints were harmed during creation of this instance. Our reduceBy now can be constructed with a refix "cast" (a hylomorphism that gets its algebra and coalgebra from (Co)recursive instances):

reduceBy :: Ord k => ListAlgebra t b -> (t -> k) -> [t] -> M.Map k b
reduceBy valueAlgebra keyFn =
    fmap (cata valueAlgebra) . unXMap . refix . map (keyFn &&& id)

Note that the approach is completely modular: you can easily tear the function apart into independent combinators, and also can construct the maps flexibly using anamorphisms and other unfolds instead of just consuming lists.

Answer 2

I don't see anything wrong with your approach. The arguments to alter are not too pleasant to look at, but that's mostly beacues alter is a little clumsy to use. Since you don't need to remove elements from the map, it is possible to rewrite fooAlgebra using insertWith rather than alter...

fooAlgebra
  :: Ord k =>
     (ListF t a -> a) -> (t -> k) -> ListF t (M.Map k a) -> M.Map k a
fooAlgebra valueAlgebra keyFn = \case
    Nil -> M.empty
    Cons elt acc -> M.insertWith
         (\_ grpAcc -> valueAlgebra (Cons elt grpAcc))
         (keyFn elt)
         (valueAlgebra (Cons elt (valueAlgebra Nil)))
         acc

... which you may or may not find an improvement.

As for using a catamorphism, it feels like a natural thing to do, as you are destroying the original structure to produce a group-wise summary of the elements. (It is also worth noting that if keyFn is a constant function then reduceBy becomes, in essence, a plain old fold of all elements with valueAlgebra.) The refactoring that danidiaz suggests (i.e. separating the valueAlgebra catamorphism from the grouping one) arguably makes that more evident:

reduceBy valueAlgebra keyFn =
    fmap (cata valueAlgebra) . cata (groupAlgebra keyFn)

groupAlgebra
  :: Ord k => (t -> k) -> ListF t (M.Map k [t]) -> M.Map k [t]
groupAlgebra keyFn = \case
    Nil -> M.empty
    Cons elt acc -> M.alter
         (Just . (elt :) . fromMaybe [])
         (keyFn elt)
         acc