Category Theory for Programmers: Exercises (Chapter 8)

1. Show that the data type:

data Pair a b = Pair a b

is a bifunctor. For additional credit implement all three methods of Bifunctor and use equational reasoning to show that these definitions are compatible with the default implementations whenever they can be applied.

Implement the Bifunctor methods:

instance Bifunctor Pair where
  bimap g h (Pair a b) = Pair (g a) (h b)
  first g = bimap g id
  second = bimap id

Demonstrate compatibility:

    bimap g h (Pair a b)
=>  Pair (g a) (h b)
=>  Pair (g (id a)) (id (h b))
=>  bimap g id (Pair (id a) (h b))
=>  (bimap g id . bimap id h) (Pair a b)
=>  (first g . second h) (Pair a b)

2. Show the isomorphism between the standard definition of Maybe and the desugaring:

type Maybe` a = Either (Const () a) (Identity a)

For additional credit, show that they are the inverse of each other using equational reasoning.

Inverse functions:

maybeToMaybe :: Maybe' a -> Maybe a
maybeToMaybe (Const () a) = Nothing
maybeToMaybe (Identity a) = Just a

maybeToMaybe' :: Maybe a -> Maybe' a
maybeToMaybe' Nothing = Const ()
maybeToMaybe' (Just a) = Identity a

Equational reasoning:

    Maybe` a
=>  Either (Const () a) (Identity a)
=>  Left (Const ()) | Right (Identity a)
=>  Const () | Identity a
=>  Nothing | Just a
=>  Maybe a

3. Let’s try another data structure. I call it PreList because it’s a precursor to a List. It replaces recursion with a type parameter b.

data PreList a b = Nil | Cons a b

Show that PreList is an instance of Bifunctor.

Implementation of bimap:

instance Bifunctor Prelist where
  bimap g h Nil = Nil
  bimap g h (Cons a b) = Cons (g a) (h b)

4. Show that following data types define bifunctors in a and b:

data K2 c a b = K2 c

data Fst a b = Fst a

data Snd a b = Snd b

Implementations of bimap:

instance Bifunctor (K2 c) where
  bimap _ _ (K2 x) = K2 x

instance Bifunctor Fst where
  bimap g _ (Fst a) = Fst (g a)

instance Bifunctor Snd where
  bimap _ h (Snd b) = Snd (h b)

5. Define a bifunctor in a language other than Haskell. Implement bimap for a generic pair in that language.

I added the of method to the classes so that a new instance of the particular bifunctor can be created in the default implementation of bimap, following the calls to first and second to get the modified values.

I adjusted the types of bimap, first and second to make the Bifunctor<A, B> an implicit input via the this object. I found I was wrestling with the code trying to make it purely functional, which I take as an indication that languages not designed for a particular paradigm can’t strictly be made to fit that paradigm (or not without too great an effort).

const id = <T,>(x: T) => x

type Fn<A, B> = (a: A) => B

interface IBifunctor<A, B> {
    bimap: <C, D>(g: Fn<A, C>) => (h: Fn<B, D>) => Bifunctor<C, D>
    first: <C>(g: Fn<A, C>) => Bifunctor<C, B>
    second: <D>(h: Fn<B, D>) => Bifunctor<A, D>
}

class Bifunctor<A, B> implements IBifunctor<A, B> {
    a: A
    b: B

    constructor(a: A, b: B) {
        this.a = a
        this.b = b
    }

    of(a: A, b: B) {
        return new Bifunctor(a, b)
    }

    bimap<C>(g: Fn<A, C>) {
        return <D>(h: Fn<B, D>) => {
            const fst = this.first(g)
            const snd = this.second(h)
            return this.of(fst.a, snd.b)
        } 
    }

    first<C>(g: Fn<A, C>) {
        return this.bimap(g)(id)
    }

    second<D>(h: Fn<B, D>) {
        return this.bimap(id)(h)
    }
}

class Pair<A, B> extends Bifunctor<A, B> {
    value: [A, B]

    constructor(a: A, b: B) {
        super(a, b)
        this.value = [a, b]
    }

    of(a: A, b: B) {
        return new Pair(a, b)
    }

    bimap<C>(g: Fn<A, C>) {
        return <D>(h: Fn<B, D>) => new Pair(g(this.a), h(this.b))
    }

    first: <C>(g: Fn<A, C>) => Pair<C, B> = super.first
    second: <D>(h: Fn<B, D>) => Pair<A, D> = super.second
}

const timesTwo = (n: number) => n * 2
const shout = (s: string) => s.toUpperCase() + '!'

const pair = new Pair(2, 'hello world')

const first = pair.first(timesTwo)
const second = pair.second(shout)
const bimap = pair.bimap(timesTwo)(shout)

pair.value   // [ 2, 'hello world' ]
first.value  // [ 4, 'hello world' ]
second.value // [ 2, 'HELLO WORLD!' ]
bimap.value  // [ 4, 'HELLO WORLD!' ]