Practical Recursion Schemes

The Basics

{-# LANGUAGE DeriveFunctor #-}import Data.Functor.Foldable
import Data.List.Ordered (merge)
import Prelude hiding (Foldable, succ)
data Natural =
Zero
| Succ Natural
data NatF r =
ZeroF
| SuccF r
deriving (Show, Functor)
data ListF a r =
NilF
| ConsF a r
deriving (Show, Functor)
data TreeF a r =
EmptyF
| LeafF a
| NodeF r r
deriving (Show, Functor)
type Nat    = Fix NatF
type List a = Fix (ListF a)
type Tree a = Fix (TreeF a)
zero :: Nat
zero = Fix ZeroF
succ :: Nat -> Nat
succ = Fix . SuccF
nil :: List a
nil = Fix NilF
cons :: a -> List a -> List a
cons x xs = Fix (ConsF x xs)
> succ (succ (succ zero))
Fix (SuccF (Fix (SuccF (Fix (SuccF (Fix ZeroF))))))
newtype Fix f = Fix (f (Fix f))fix :: f (Fix f) -> Fix f
fix = Fix
unfix :: Fix f -> f (Fix f)
unfix (Fix f) = f

Understanding Some Internal Plumbing

project :: Foldable t   => t -> Base t t
embed :: Unfoldable t => Base t t -> t
type family Base t :: * -> *
type instance Base (Fix f) = f

Some Useful Schemes

natsum :: Nat -> Int
natsum = cata alg where
alg ZeroF = 0
alg (SuccF n) = n + 1
{-# LANGUAGE LambdaCase #-}natsum :: Nat -> Int
natsum = cata $ \case ->
ZeroF -> 0
SuccF n -> n + 1
cata :: Foldable t => (Base t a -> a) -> t -> a
> :kind! Base Nat Int
Base Nat Int :: *
= NatF Int
filterL :: (a -> Bool) -> List a -> List a
filterL p = cata alg where
alg NilF = nil
alg (ConsF x xs)
| p x = cons x xs
| otherwise = xs
nat :: Int -> Nat
nat = ana coalg where
coalg n
| n <= 0 = ZeroF
| otherwise = SuccF (n - 1)
para :: Foldable t => (Base t (t, a) -> a) -> t -> a
> :kind! Base Nat (Nat, Int)
Base Nat (Nat, Int) :: *
= NatF (Nat, Int)
natfac :: Nat -> Int
natfac = para alg where
alg ZeroF = 1
alg (SuccF (n, f)) = natsum (succ n) * f
0!       = 1
(k + 1)! = (k + 1) * k!
natpred :: Nat -> Nat
natpred = para alg where
alg ZeroF = zero
alg (SuccF (n, _)) = n
> :set -XRankNTypes
> :kind! forall a b. Base (List a) (List a, b)
forall a b. Base (List a) (List a, b) :: *
= forall a b. ListF a (Fix (ListF a), b)
tailL :: List a -> List a
tailL = para alg where
alg NilF = nil
alg (ConsF _ (l, _)) = l
hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
mergeSort :: Ord a => [a] -> [a]
mergeSort = hylo alg coalg where
alg EmptyF = []
alg (LeafF c) = [c]
alg (NodeF l r) = merge l r
coalg [] = EmptyF
coalg [x] = LeafF x
coalg xs = NodeF l r where
(l, r) = splitAt (length xs `div` 2) xs

Wrapping Up

--

--

Quanty tech guy. https://jtobin.io

Love podcasts or audiobooks? Learn on the go with our new app.

Get the Medium app

A button that says 'Download on the App Store', and if clicked it will lead you to the iOS App store
A button that says 'Get it on, Google Play', and if clicked it will lead you to the Google Play store