Lattice paths algorithm using recursion schemes

I'm playing around with some recursion schemes, namely catamorphisms and anamorphisms, and would like to try to implement a solution to the lattice paths algorithm as described below using them (taken from a collection of interview questions):

Prompt:  Count the number of unique paths to travel from the top left
          order to the bottom right corner of a lattice of M x N squares.

          When moving through the lattice, one can only travel to the
          adjacent corner on the right or down.

 Input:   m {Integer} - rows of squares
 Input:   n {Integer} - column of squares
 Output:  {Integer}

 Example: input: (2, 3)

          (2 x 3 lattice of squares)
           __ __ __

          output: 10 (number of unique paths from top left corner to bottom right)**

Using normal recursion, you could solve this with something like:

lattice_paths m n =
         if m == 0 and n == 0 then 1
         else if m < 0 or n < 0 then 0
         else (lattice_paths (m - 1) n) + lattice_paths m (n - 1)

My Fix, cata and ana are defined as follows:

newtype Fix f = In (f (Fix f))

deriving instance (Eq (f (Fix f))) => Eq (Fix f)
deriving instance (Ord (f (Fix f))) => Ord (Fix f)
deriving instance (Show (f (Fix f))) => Show (Fix f)

out :: Fix f -> f (Fix f)
out (In f) = f

-- Catamorphism
type Algebra f a = f a -> a

cata :: (Functor f) => Algebra f a -> Fix f -> a
cata f = f . fmap (cata f) . out

-- Anamorphism
type Coalgebra f a = a -> f a

ana :: (Functor f) => Coalgebra f a -> a -> Fix f
ana f = In . fmap (ana f) . f

The approach mentioned in this post (https://stackoverflow.com/a/56012344) for writing recursion schemes that go from Int -> Int, is to write a hylomorphism where the anamorphism sort of builds the call stack and the catamorphism the evaluation of said callstack. I'm not sure how to build the call stack here.


  • Perhaps something like this:

    data CallStack a = Plus a a | Base Int deriving Functor
    produceStack :: Coalgebra CallStack (Int, Int)
    produceStack (m, n) =
        if m == 0 && n == 0 then Base 1
        else if m < 0 || n < 0 then Base 0
        else Plus (m-1, n) (m, n-1)
    consumeStack :: Algebra CallStack Int
    consumeStack (Base n) = n
    consumeStack (Plus a b) = a + b

    "Stack" is a funny name for this call structure. It's not very stack-like.