Raw notes from Patterns of Functional Programming course from Midlands Graduate School 2015

Lecture1.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS -Wall -fno-warn-orphans #-}
module Lecture1 where

import Data.List (partition)

newtype Fix s = In { out :: s (Fix s) }

data ListF a b
  = NilF
  | ConsF a b
  deriving (Show)

type List a = Fix (ListF a)

data TreeF a b
  = EmptyF
  | NodeF b a b
  deriving (Show)

type Tree a = Fix (TreeF a)

fold :: Functor s => (s b -> b) -> (Fix s -> b)
fold f = f . fmap (fold f) . out

class Bifunctor s where
  bimap :: (a -> b) -> (c -> d) -> s a c -> s b d

instance Bifunctor ListF where
  bimap f g = \case
    NilF -> NilF
    ConsF x y -> ConsF (f x) (g y)

instance Bifunctor TreeF where
  bimap f g = \case
    EmptyF -> EmptyF
    NodeF l m r -> NodeF (g l) (f m) (g r)

instance Bifunctor s => Functor (s a) where
  fmap = bimap id

-- Lecture 2

deriving instance (Show (s (Fix s))) => Show (Fix s)

unfold :: Functor s => (a -> s a) -> (a -> Fix s)
unfold f = In . fmap (unfold f) . f
-- Universal property: h = unfold f <=> in' . h = fmap h . f

glue :: TreeF a [a] -> [a]
glue = \case
  EmptyF -> []
  NodeF l m r -> l ++ [m] ++ r

flatten :: Tree a -> [a]
flatten = fold glue
  where

-- Trees we can generate, but not consume
type CoTree a = Fix (TreeF a)

grow :: Ord a => [a] -> CoTree a
grow = unfold split

split :: Ord a => [a] -> TreeF a [a]
split = \case
  [] -> EmptyF
  (x : xs) -> NodeF ys x zs where
    (ys, zs) = partition (< x) xs

tsort :: Ord a => [a] -> [a]
tsort = flatten . grow

{-
  tsort
=   [definition tsort]
  flatten . grow
=   [definition flatten, definition grow]
  fold glue . unfold split
=   [definition fold, definition unfold]
  glue . fmap flatten . out . In . fmap grow . split
=   [out . In = id]
  glue . fmap flatten . fmap grow . split
=   [fmap (f . g) = fmap f . fmap g]
  glue . fmap (flatten . grow) . split
=   [definition tsort]
  glue . fmap tsort . split

Last equation can be used to _define_ tree sort, which actually makes progress

Hylomorphism: non-fold after a fold, and basically describe "divide and conquer"
pattern: split a data structure into parts, process parts independently (thus fmap),
and combine results.
-}

tsort' :: Ord a => [a] -> [a]
tsort' = glue . fmap tsort' . split

-- Universal property for fold holds only for strict functions h

-- Exercise session 2

data NatF a = Z | S a deriving (Functor, Show)

type Nat = Fix NatF

fromNat :: Nat -> Integer
fromNat = fold $ \case
  Z -> 0
  S n -> n + 1

toNat :: Integer -> Nat
toNat = unfold $ \case
  0 -> Z
  n -> S (n - 1)

add :: Nat -> Nat -> Nat
add m = fold $ \case
  Z -> m
  S n -> In (S n)

mul :: Nat -> Nat -> Nat
mul m = fold $ \case
  Z -> In Z
  S n -> n `add` m

fact :: Nat -> (Nat, Nat)
fact = fold $ \case
  Z -> (In Z, In $ S (In Z))
  S (n, fn) -> (In (S n), In (S n) `mul` fn)

-- Lecture 3: Sorting functions

type Nu = Fix
type Mu = Fix

{-
Going to write sorting algorithms as functions of type Mu F -> Nu G, and thus
can use both fold and unfold as outermost function:

h :: Mu F -> Nu F
h = fold (f :: F (Nu G) -> Nu G)
  where
    f = unfold (g  :: F (Nu G) -> G (F (Nu G)))

h :: Mu F -> Nu F
h = unfold (f :: F (Mu F) -> G (Mu F))
  where
    f = fold (g  :: F (G (Mu F)) -> G (Mu F))

Basically, when we're writing functions Mu F -> Nu G as fold (unfold f) or
unfold (fold f), we're interested in functions of type F (G a) -> G (F a),
which could be natural transformation.

delta :: forall a. F (G a) -> G (F a) is called a distributive law.

-}

type L = ListF Integer

-- L' is isomorphic to ListF Integer, but is intended to be used only for sorted lists
data L' x
  = Nil
  | Cons Integer x
  deriving (Functor)

bsort :: Mu L -> Nu L'
bsort = unfold $ fold (fmap In . swap)

isort :: Mu L -> Nu L'
isort = fold $ unfold (swap . fmap out)

swap :: L (L' a) -> L' (L a)
swap = \case
  NilF -> Nil
  ConsF a Nil -> Cons a NilF
  ConsF a (Cons b r)
    | a <= b -> Cons a (ConsF b r) -- discarding information about sortedness here!
    | otherwise -> Cons b (ConsF a r)