Recursion:

schemes, algebras, finally tagless,

data types

Alexander Konovalov, Compellon Inc

alex.knvl@gmail.com @alexknvl

The goal

  • Briefly go over type isomorphisms and type algebra.
  • Show the connection between final tagless, "initial encoding", and recursion schemes.
  • Brief introduction to Free monads.
  • Show the connection between Free monads, MTL, and Final Tagless.

Isomorphisms

​A and B are isomorphic when there exist two morphisms,

to: A → B and from: B → A, such that both

 

from (to a) = a

and

to (from b) = b

Type Isomorphisms

Can't be faithfully implemented except in Dependently typed languages (Idris, Agda, Coq).

data Iso a b = Iso {
  to   :: a -> b
  from :: b -> a
  fromTo :: (x : a) -> from (to x) = x
  toFrom :: (x : b) -> to (from x) = x
}
trait Iso[A, B] {
  def to(a: A): B
  def from(b: B): A
  def fromTo(x: A): (from(to(x))).type =:= x.type
  def toFrom(x: B): (to(from(x))).type =:= x.type
}
data Iso a b = Iso {
  to   :: a -> b
  from :: b -> a
  -- make sure that to . from = id
  -- and from . to = id
}
trait Iso[A, B] {
  def to(a: A): B
  def from(b: B): A
 
  // make sure that (to andThen from) == id
  // and (from andThen to) == id
}

So let's just manually prove equality.

type A = Either Bool ()
data B = One | Two | Three
type A = Either[Boolean, Unit]
sealed trait B
case object One extends B
case object Two extends B
case object Three extends B

Are these isomorphic?

to :: A -> B
to (Left True)  = One
to (Left False) = Two
to (Right ())   = Three
def to(a: A): B = a match {
  case Left(true)  => One
  case Left(false) => Two
  case Right(())   => Three
}

Yes

type A = Boolean -> Boolean
data B = One | Two | Three | Four
type A = Boolean => Boolean
sealed trait B
case object One   extends B
case object Two   extends B
case object Three extends B
case object Four  extends B

Are these isomorphic?

to f = case (f True, f False) of
         (False, False) -> One
         (False, True)  -> Two
         (True, False)  -> Three
         (True, True)   -> Four
def to(f: A): B = (f(true), f(false)) match {
  case (false, false) => One
  case (false, true)  => Two
  case (true, true)   => Three
  case (true, true)   => Four
}

Yes.

type A = Bool -> ()
type B = Void -> Int
type C = ()
type A = Boolean => Unit
type B = Nothing => Int
type C = Unit

Are these isomorphic?

to :: A -> B
to f   = absurd
from f = \_ -> ()

to :: B -> C
to f    = ()
from () = absurd
def to(f: Boolean => Unit): Nothing => Int = 
  (a: Nothing) => a
def from(f: Nothing => Int): Boolean => Unit = 
  (a: Boolean) => ()

def to(f: Nothing => Int): Unit = ()
def from(f: Unit): Nothing => Int = 
  (a: Nothing) => a

Maybe...?

A surprising detour

  • When are two things equal?

 

1729

12³+1

"the first number expressible as a sum of two cubes in two different ways"

 

  • When are two things equal?

http://www.math.harvard.edu/~mazur/preprints/when_is_one.pdf

Gottfried Wilhelm Leibniz, 1646-1716:

For any x and y, if x is identical to y, then x and y have all the same properties.

For any x and y, if x and y have all the same properties, then x is identical to y.

https://plato.stanford.edu/entries/identity-indiscernible/

x = y ⟺ ∀ P. P x ↔ P y

Where P is quantified over all properties of an object.

https://plato.stanford.edu/entries/identity-indiscernible/

x = y ⟺ ∀ P. P x ↔ P y

If 1729 and 12³+1 are expressions, they are different.

 

data Expr = Lit Int | Pow Int Int | Add Int Int

x = Lit 1729
y = Add (Pow 12 3) 1
sealed trait Expr
case class Lit(i: Int) extends Expr
case class Pow(a: Int, b: Int) extends Expr
case class Add(a: Int, b: Int) extends Expr

val x = Lit(1729)
val y = Add(Pow(12, 3), 1)

x = y ⟺ ∀ P. P x ↔ P y

If 1729 and 12³+1 are integers, they are the same.

type Expr = Int

x = 1729
y = 12^3 + 1
type Expr = Int

val x = 1729
val y = 12 * 12 * 12 + 1

Type Isomorphisms

type A = Bool -> ()
type B = Void -> Int
to f   = absurd
from f = \_ -> ()
type A = Boolean => Unit
type B = Nothing => Int

def to(f: Boolean => Unit): Nothing => Int = 
  (a: Nothing) => a
def from(f: Nothing => Int): Boolean => Unit = 
  (a: Boolean) => ()

Are these isomorphic?

test1 :: (Bool -> ()) -> Bool
test1 f = ???

test1 (\_ -> ())
test1 (\True  -> ()
        False -> ())

test2 :: (Void -> Int) -> Bool
test2 f = ???

test2 (\_ -> 1)
test2 (\_ -> 2)
test2 (\x -> absurd x)

What properties of them can we observe?

We can't see the difference of them

as values within a pure functional language.

We can see the difference between

the actual expression trees.

We don't really care about the latter as since it does not affect the semantics.

type A = Bool -> ()
type B = Void -> Int
to f   = absurd
from f = \_ -> ()
type A = Boolean => Unit
type B = Nothing => Int

def to(f: Boolean => Unit): Nothing => Int = 
  (a: Nothing) => a
def from(f: Nothing => Int): Boolean => Unit = 
  (a: Boolean) => ()

Are these isomorphic? Yes.

An interesting result:

 

If A and B are isomorphic,
(a₁: A) and (a₂: A) map to (b₁: A) and (b₂: A) respectively,
then a₁ = a₂ ⟺ b₁ = b₂.

In other words, discernible objects are mapped to discernible objects.

Equal objects are mapped to equal objects.

An interesting result:

 

If A and B are isomorphic,
(a₁: A) and (a₂: A) map to (b₁: A) and (b₂: A) respectively,
then a₁ = a₂ ⟺ b₁ = b₂.

a₁ = a₂

to a₁ = to a₂

b₁ = b₂

from b₁ = from b₂

Type Algebra

A few more important isomorphisms:

 

(a, b) ≈ (b, a)
(a, (b, c)) ≈ ((a, b), c)
(a, Either b c) ≈ Either (a, b) (a, c)
Either a b ≈ Either b a
Either Void a ≈ a
(Unit, a) ≈ a

Type Algebra

(a, b) ≈ (b, a)
(a, (b, c)) ≈ ((a, b), c)
(a, Either b c) ≈ Either (a, b) (a, c)
Either a b ≈ Either b a
Either Void a ≈ a
(Unit, a) ≈ a

What if we replace Either with +, (,) with *, Unit with 1, and Void with 0?..

Type Algebra

(a, b) ≈ (b, a)
(a, (b, c)) ≈ ((a, b), c)
(a, Either b c) ≈ Either (a, b) (a, c)
Either a b ≈ Either b a
Either Void a ≈ a
(Unit, a) ≈ a

a * b ≈ b * a
a * (b * c) ≈ (a * b) * c
a * (b + c) ≈ a * b + a * c
a + b ≈ b + a
0 + a ≈ a
1 * a ≈ a

Amusingly, we get something very similar to the regular algebra of natural numbers...

Type Algebra

(a + b) c ≈ (a c, b c)
a b c ≈ (a, b) c

def curry[A, B, C](f: A => B => C): ((A, B)) => C =
    { case (a, b) => f(a)(b) }

def uncurry[A, B, C](f: ((A, B)) => C): A => B => C =
    a => b => f((a, b))

def undiag[A, B, C](f: Either[A, B] => C): (A => C, B => C) =
    (a => f(Left(a)), b => f(Right(b)))

def diag[A, B, C](f: (A => C, B => C)): Either[A, B] => C =
    { case Left(a)  => f._1(a)
      case Right(b) => f._2(b) }

Type Algebra

(a + b) c ≈ (a c, b c)
a b c ≈ (a, b) c

c^(a + b) ≈ c^a * c^b
(c^b)^a ≈ c ^ (a * b)

Turns out that similarly to how Either is + and (,) is *, functions correspond to exponentiation:

Type Algebra

Summing it all up:

Either[a, b] is +

Tuple2[a, b] or (a, b) is A * B

Function1[a, b] or (a → b) is b ^ a

Nothing is 0

Unit is 1

Bool is 2

Type Algebra

One more thing that we will need.

a ≈ b, then f a ≈ f b for any functor f

Including phantom, covariant, contravariant, or invariant functors.

Type Algebra

a ≈ b, then f a ≈ f b for any functor f

to' = map to

from' = map from

map to . map from =

map (to . from) = map id = id

Let's talk recursion

Say we have a data type

data List a = Nil | Cons a (List a)
foldr :: forall a z. z -> (a -> z -> z) -> List a -> z
foldr seed combine = go where
  go Nil        = seed
  go (Cons h t) = combine h (go t)

and we would like to fold over it

let’s look at the type of foldr more closely

foldr :: forall a z. z -> (a -> z -> z) -> List a -> z
foldr seed combine = go where
  go Nil        = seed
  go (Cons h t) = combine h (go t)
\forall a~z. z \rightarrow (a \rightarrow z \rightarrow z) \rightarrow [a] \rightarrow z
\forall a~z. (1 \rightarrow z) \rightarrow ((a, z) \rightarrow z) \rightarrow [a] \rightarrow z
\forall a~z. ((1 + (a, z)) \rightarrow z) \rightarrow [a] \rightarrow z
\forall a~z. (1 \rightarrow z, (a, z) \rightarrow z) \rightarrow [a] \rightarrow z
\forall a~z. ((1 + (a, z)) \rightarrow z) \rightarrow [a] \rightarrow z
data ListF a z = NilF | ConsF a z

We can now define a new type, called pattern functor

foldr :: forall a z. (ListF a z -> z) -> List a -> z
foldr alg = go where
  go Nil        = alg NilF
  go (Cons h t) = alg (ConsF h (go t))

New foldr:

Let's try the same technique with a different type:

data Expr = Lit Int 
          | Add Expr Expr 
          | Mul Expr Expr
foldExpr :: forall z. (Int -> z) -> (z -> z -> z) -> (z -> z -> z) -> Expr -> z
foldExpr lit add mul = go where
  go (Lit i)    = lit i
  go (Add l r)  = add (go l) (go r)
  go (Mul l r)  = mul (go l) (go r) 
\forall z. (Int \rightarrow z) \rightarrow (z \rightarrow z \rightarrow z) \\ ~~~ \rightarrow (z \rightarrow z \rightarrow z) \rightarrow \text{Expr} \rightarrow z
∀ z. (Int \rightarrow z) \rightarrow ((z, z) \rightarrow z) \\ ~~~ \rightarrow ((z, z) \rightarrow z) \rightarrow \text{Expr} \rightarrow z
foldExpr :: forall z. (Int -> z) -> (z -> z -> z) -> (z -> z -> z) -> Expr -> z
foldExpr lit add mul = go where
  go (Lit i)    = lit i
  go (Add l r)  = add (go l) (go r)
  go (Mul l r)  = mul (go l) (go r) 
\forall z. ((Int + (z, z) + (z, z)) \rightarrow z) \\ ~~~~~ \rightarrow \text{Expr} \rightarrow z
∀ z. (Int \rightarrow z) \rightarrow ((z, z) \rightarrow z) \\ ~~~ \rightarrow ((z, z) \rightarrow z) \rightarrow \text{Expr} \rightarrow z
data ExprF z = LitF Int | AddF z z | MulF z z

Once again, we introduce a pattern functor

\forall z. (\text{ExprF}~z \rightarrow z) \rightarrow \text{Expr} \rightarrow z
data ExprF z = LitF Int | AddF z z | MulF z z
\forall z. (\text{ExprF}~z \rightarrow z) \rightarrow \text{Expr} \rightarrow z
foldExpr' :: forall z. (ExprF z -> z) -> Expr -> z
foldExpr' alg = go where
  go (Lit x)   = alg (LitF x)
  go (Add x y) = alg (AddF (go x) (go y))
  go (Mul x y) = alg (MulF (go x) (go y))

Alright, let's go back to our types again

∀ z. (Int \rightarrow z, z \rightarrow z \rightarrow z, z \rightarrow z \rightarrow z) \\ ~~~~~ \rightarrow Expr \rightarrow z
\forall z. (Int \rightarrow z) \rightarrow (z \rightarrow z \rightarrow z) \\ ~~~ \rightarrow (z \rightarrow z \rightarrow z) \rightarrow Expr \rightarrow z
data ExprA z = {
  lit :: Int -> z
  add :: z -> z -> z
  mul :: z -> z -> z
}
∀ z. (Int \rightarrow z, z \rightarrow z \rightarrow z, z \rightarrow z \rightarrow z) \\ ~~~~~ \rightarrow Expr \rightarrow z

Let's define an "algebra"

∀ z. \text{ExprA}~z \rightarrow \text{Expr} \rightarrow z
∀ z. \text{ExprA}~z \rightarrow \text{Expr} \rightarrow z
foldExpr'' :: forall z. ExprA z -> Expr -> z
foldExpr'' alg = go where
  go (Lit x)   = alg `lit` x
  go (Add x y) = (alg `add`) (go x) (go y)
  go (Mul x y) = (alg `mul`) (go x) (go y)

But that's not all!

class ExprC z where
  lit :: Int -> z
  add :: z -> z -> z
  mul :: z -> z -> z
foldExpr''' :: forall z. ExprC z => Expr -> z
foldExpr''' = go where
  go (Lit x)   = lit x
  go (Add x y) = (go x) `add` (go y)
  go (Mul x y) = (go x) `mul` (go y)

Let's see all of the derived functions

foldExpr :: forall z. (Int -> z) -> (z -> z -> z) -> (z -> z -> z) -> Expr -> z
foldExpr :: forall z. (ExprF z -> z)                               -> Expr -> z
foldExpr :: forall z.  ExprA z                                     -> Expr -> z
foldExpr :: forall z.  ExprC z                                     => Expr -> z

Huh, recursion schemes and final tagless!

Let's talk recursion schemes

\begin{aligned} \text{Expr} = &\text{Lit}~\text{Int} \\ | &\text{Add}~\text{Expr}~\text{Expr} \\ | &\text{Mul}~\text{Expr}~\text{Expr} \end{aligned}
\begin{aligned} \text{ExprF} \bullet = &\text{Lit}~\text{Int} \\ | &\text{Add}~\bullet~\bullet \\ | &\text{Mul}~\bullet~\bullet \end{aligned}
project :: Expr -> ExprF Expr
project (Lit i)   = LitF i
project (Add x y) = AddF x y
project (Mul x y) = MulF x y
embed :: ExprF Expr -> Expr
embed (LitF i)   = Lit i
embed (AddF x y) = Add x y
embed (MulF x y) = Mul x y
data ExprF z = LitF Int | AddF z z | MulF z z
  deriving (Functor ExprF)
project :: Expr -> ExprF Expr
project (Lit i)   = LitF i
project (Add x y) = AddF x y
project (Mul x y) = MulF x y

embed :: ExprF Expr -> Expr
embed (LitF i)   = Lit i
embed (AddF x y) = Add x y
embed (MulF x y) = Mul x y

data ExprF z = LitF Int | AddF z z | MulF z z
  deriving (Functor ExprF)
foldExpr :: forall z. (ExprF z -> z) -> Expr -> z
foldExpr alg = go where
  go (Lit x)   = alg (LitF x)
  go (Add x y) = alg (AddF (go x) (go y))
  go (Mul x y) = alg (MulF (go x) (go y))

foldExpr alg = go where
  go x = alg $ fmap go $ project x

foldExpr alg = go where
  go = alg . fmap go . project
type Algebra f a = f a -> a

foldExpr :: forall z. Algebra ExprF -> Expr -> z

foldExpr alg = go where
  go = alg . fmap go . project

cata :: forall z. Algebra ExprF -> Expr -> z
class Functor f => Recursive t f | t -> f where
  project :: t -> f t
  embed   :: f t -> t
  cata    :: Algebra f a -> t -> a

  cata alg = go where
    go = alg . fmap go . project

Hmm, algebras! Where else have you heard that word?

Let's talk algebras

What is an algebra?

In mathematics, and more specifically in abstract algebra, an algebraic structure on a set A (called carrier set or underlying set) is a collection of finitary operations on A; the set A with this structure is also called an algebra.

What is an algebra?

In mathematics, specifically in category theory, F-algebras generalize algebraic structure. Rewriting the algebraic laws in terms of morphisms eliminates all references to quantified elements from the axioms, and these algebraic laws may then be glued together in terms of a single functor F, the signature.

Let's talk algebras

\mathfrak{F} c \rightarrow c ~~~ - ~~~ \text{an }\mathfrak{F}\text{-algebra}
\mathfrak{F} - \text{is called a signature, or pattern functor} \\ c - \text{is called a carrier}
type Algebra f c = f c -> c
type Algebra f c = f c -> c
data ExprF z = LitF Int | AddF z z | MulF z z
  deriving (Functor ExprF)

type ExprA' z = Algebra ExprF z

data ExprA z = {
  lit :: Int -> z
  add :: z -> z -> z 
  mul :: z -> z -> z
}

class ExprC z where
  lit :: Int -> z
  add :: z -> z -> z 
  mul :: z -> z -> z

All of these are algebras!

class ExprC z where
  lit :: Int -> z
  add :: z -> z -> z 
  mul :: z -> z -> z

foo :: ExprC z => z
foo = (lit 10 `add` lit 30) `mul` lit 10

We can reinterpret the same function in many ways

instance ExprC Int where
  lit x = x
  add x y = x + y
  mul x y = x * y

instance ExprC String where
  lit x = show x
  add x y = "(" <> show x <> " + " <> show y <> ")"
  mul x y = "(" <> show x <> " * " <> show y <> ")"

foo = (lit 10 `add` lit 30) `mul` lit 10

boo :: String
boo = foo -- 400

baz :: Int
baz = foo -- "((10 + 30) * 10)"

We can reinterpret the same function in many ways

evalAlg = Algebra ExprF Int
evalAlg = \case (LitF x)   -> x
                (AddF x y) -> x + y 
                (MulF x y) -> x * y

printAlg = Algebra ExprF String
printAlg = \case (LitF x)   -> show x
                 (AddF x y) -> "(" <> show x <> " + " <> show y <> ")"
                 (MulF x y) -> "(" <> show x <> " * " <> show y <> ")"

foo = (Lit 10 `Add` Lit 30) `Mul` Lit 10

boo :: String
boo = cata evalAlg foo  -- 400

baz :: Int
baz = cata printAlg foo -- "((10 + 30) * 10)"

But the same idea applies to Recursion schemes!

But the same idea applies to final tagless expressed using dictionaries!

evalAlg :: ExprA Int
evalAlg = ExprA {
  lit x = x
  add x y = x + y
  mul x y = x * y
}

printAlg :: ExprA String
printAlg = ExprA {
  lit x = show x
  add x y = "(" <> show x <> " + " <> show y <> ")"
  mul x y = "(" <> show x <> " * " <> show y <> ")"
}

foo = (Lit 10 `Add` Lit 30) `Mul` Lit 10

boo :: String
boo = foldExpr evalAlg foo  -- 400

baz :: Int
baz = foldExpr printAlg foo -- "((10 + 30) * 10)"
data Free f a = Pure a | Suspend (f (Free f a))

instance Functor f => Monad (Free f) where
  return = Pure
  (>>=) :: Free f a -> (a -> Free f b) -> Free f b
  (Pure a)      >>= f = f a
  (Suspend ffa) >>= f = Suspend $ (>>= f) <$> ffa

runFree :: Monad g => (f :~> g) -> Free f a -> g a
runFree (Nat eval) (Pure a)      = return a
runFree (Nat eval) (Suspend ffa) =
  (>>= id) $ runFree (Nat eval) <$> eval ffa

Let's talk Free monads

data ServiceF a = Get Int (Int -> a)
                | Set Int Int a
deriving instance (Functor ServiceF)

get :: Int -> Free ServiceF Int
get key = Suspend (Get key return)

set :: Int -> Free ServiceF ()
set key val = Suspend (Set key val (pure ()))

Let's talk Free monads

data ServiceF a = Get Int (Int -> a) | Set Int Int a
  deriving (Functor ServiceF)

get :: Int -> Free ServiceF Int
get key = Suspend (Get key return)

set :: Int -> Free ServiceF ()
set key val = Suspend (Set key val (pure ()))

Recursion

By Alexander Konovalov

Recursion

  • 134
Loading comments...

More from Alexander Konovalov