Three examples of recursion schemes drawn from mathematics, showing the use of linked lists as control structures.

Paramorphisms

Integer Partitions

import Numeric.Natural       (Natural)
import Control.Monad         (join)
import Data.List             (nub)
import Data.Functor.Foldable (ListF (..), para)

partitions :: Natural -> [[Natural]]
partitions = para algebra
    where algebra Nothing          = []
          algebra (Just (0,_))     = [[1]]
          algebra (Just (_, past)) = (nub . (getAll =<<)) (fmap (1:) past)

getAll :: [Natural] -> [[Natural]]
getAll = fmap (dropWhile (==0) . sort) . subsets
    where subsets xs = flip sumIndicesAt xs <$> indices xs

indices :: [Natural] -> [[Natural]]
indices = join . para algebra
    where algebra Nil                 = []
          algebra (Cons x (xs, []))   = [[x:xs]]
          algebra (Cons x (xs, past)) = (:) <$> [x:xs,[]] <*> past

sumIndicesAt :: [Natural] -> [Natural] -> [Natural]
sumIndicesAt ix = (\(a, b) -> sum a : b) . partition (`elem` ix)

Apomorphisms

Continued Fractions

import           Data.Functor.Foldable

isInteger :: (RealFrac a) => a -> Bool
isInteger = idem (realToFrac . floor)
    where idem = ((==) <*>)

continuedFraction :: (RealFrac a, Integral b) => a -> [b]
continuedFraction = apo coalgebra
    where coalgebra x
              | isInteger x = go $ Left []
              | otherwise   = go $ Right alpha
                  where alpha = 1 / (x - realToFrac (floor x))
                        go    = Cons (floor x)

Base Conversions

import Data.Functor.Foldable

integerToWordList :: Integral a => a -> a -> [a]
integerToWordList base = apo pc where
    pc i | i < base = Cons (fromIntegral i) (Left mempty)
         | otherwise = Cons (fromIntegral (i `mod` base)) (Right (i `div` base))

Elgot Algebras

Lengths of Collatz Sequences

import Data.Functor.Foldable

collatzLength :: Int -> Int
collatzLength = elgot algebra coalgebra

coalgebra :: Int -> Either Int (ListF Int Int)
coalgebra 1 = Left 1
coalgebra n
    | n `mod` 2 == 0 = Right $ Cons n (div n 2)
    | otherwise = Right $ Cons n (3 * n + 1)

algebra :: ListF Int Int -> Int
algebra Nil        = 0
algebra (Cons _ x) = x + 1

Co-(Elgot Algebra)s

Base Conversions

import Data.Functor.Foldable

integerToBase :: (Integral a) => a -> a -> [a]
integerToBase base = coelgot pa c where
    c i = Cons (i `mod` base) (i `div` base)
    pa (i, ws) | i < base = [fromIntegral i]
               | otherwise = embed ws

Mendler-Style Catamorphisms

Base Conversions

import Data.Functor.Foldable

wordListToInteger :: (Integral a) => a -> [a] -> a
wordListToInteger base = mcata ma . cata Fix where
    ma f (Cons x xs) = fromIntegral x + base * f xs
    ma _ Nil         = 0