Skip to content

Instantly share code, notes, and snippets.

@runarorama
Last active December 2, 2019 19:58
Show Gist options
  • Save runarorama/b6ed7b8e97cd949cc660 to your computer and use it in GitHub Desktop.
Save runarorama/b6ed7b8e97cd949cc660 to your computer and use it in GitHub Desktop.
Free/forgetful adjunctions
import scalaz._, Scalaz._
// Adjunction between `F` and `G` means there is an
// isomorphism between `A => G[B]` and `F[A] => B`.
trait Adjunction[F[_],G[_]] {
def leftAdjunct[A, B](a: A)(f: F[A] => B): G[B]
def rightAdjunct[A, B](a: F[A])(f: A => G[B]): B
}
// Adjunction between free and forgetful functor.
// We can think of the forgetful functor as taking `P a => a` to just `a`.
// That is, given `P[A]`, `Forget[P,A] = A`.
trait FreeForgetAdjunction[F[_], P[_]] {
def left[A,B](f: F[A] => B): A => B
def right[A,B:P](f: A => B): F[A] => B
}
// Class for pointed sets
case class Pointed[P](point: P)
object Pointed {
def apply[P](implicit P: Pointed[P]): Pointed[P] = P
}
// `Option[A]` is the free pointed set on `A`.
// It is left-adjoint to the functor that "loses the point".
// The `unit` is `Some` and the `counit` is `fold`.
new FreeForgetAdjunction[Option, Pointed] {
def left[A,B](f: Option[A] => B): A => B =
a => f(Some(a))
def right[A,B:Pointed](f: A => B): Option[A] => B =
_.fold(Pointed[B].point)(f)
}
// `List[A]` is the free monoid on `A`.
// It is left-adjoint to the functor that takes `Monoid[M]` to just `M`,
// as witnessed by the singleton list constructor and `foldMap`.
new FreeForgetAdjunction[List, Monoid] {
def left[A,B](f: List[A] => B): A => B =
a => f(List(a))
def right[A,B:Monoid](f: A => B): List[A] => B =
_.foldRight(Monoid[B].zero)((a, b) => Monoid[B].append(f(a), b))
}
// The higher-kinded case
trait FreeForgetAdjunction[C[_[_],_], P[_[_]]] {
def left[F[_],G[_]](f: C[F,?] ~> G): F ~> G
def right[F[_],G[_]:P](f: F ~> G): C[F,?] ~> G
}
// `Free[F,?]` is the free monad on `F`
// It is left-adjoint to the functor that takes `Monad[M]` to just `M`,
// as witnessed by `liftF` and `foldMap`
new FreeForgetAdjunction[Free, Monad] {
def left[F[_],G[_]](f: Free[F,?] ~> G): F ~> G = new (F ~> G) {
def apply[A](a: F[A]) = f(Free.liftF(a))
}
def right[F[_],G[_]:Monad](f: F ~> G): Free[F,?] ~> G = new (Free[F,?] ~> G) {
def apply[A](a: Free[F,A]) = a.foldMap(f)
}
}
////////////
// Monoid adjunction:
//
// Free -| Forget
//
// F -| G
//
// F[A] for a type A is the free monoid generated by A.
// G[M] for a monoid M is the type M, forgetting that it's a monoid.
// Adjunction between free and forgetful functor.
// We can think of the forgetful functor as taking `P a => a` to just `a`.
// That is, given `P[A]`, `Forget[P,A] = A`.
trait FreeForgetAdjunction[F[_], P[_]] {
def left[A,B](f: F[A] => B): A => B
def right[A,B:P](f: A => B): F[A] => B
}
// `List[A]` is the free monoid on `A`.
// It is left-adjoint to the functor that takes `Monoid[M]` to just `M`,
// as witnessed by the singleton list constructor and `foldMap`.
new FreeForgetAdjunction[List, Monoid] {
def left[A,B](f: List[A] => B): A => B =
a => f(List(a))
def right[A,B:Monoid](f: A => B): List[A] => B =
_.foldRight(Monoid[B].zero)((a, b) => Monoid[B].append(f(a), b))
def unit[A](a: A): List[A] =
left(identity[List[A]])(a)
def counit[A:Monoid](as: List[A]): A =
right(identity[A])(as)
// So the counit is `fold` in a monoid!
// `List` is a comonad in the category of monoids.
//
// What does the duplicate look like?
// It gives us the "substructure" of the free monoid.
// So, one list per element in the original list.
def duplicate[A:Monoid](as: List[A]): List[List[A]] =
as.map(unit(_))
}
// The higher-kinded case
trait FreeForgetAdjunction[C[_[_],_], P[_[_]]] {
def left[F[_],G[_]](f: C[F,?] ~> G): F ~> G
def right[F[_],G[_]:P](f: F ~> G): C[F,?] ~> G
}
trait CofreeForgetAdjunction[C[_[_],_], P[_[_]]] {
def left[F[_]:P,G[_]](f: F ~> G): F ~> C[G,?]
def right[F[_],G[_]](f: F ~> C[G,?]): F ~> G
}
object CofreeComonad extends CofreeForgetAdjunction[Cofree, Comonad] {
def left[F[_]:Comonad,G[_]](f: F ~> G): F ~> Cofree[G,?] = new (F ~> Cofree[G,?]) {
def apply[A](as: F[A]) = mapUnfold(as)(f)
}
// if `f` generates a G-branching stream, then we get a function `F ~> G` that
// "skims" the head of all the branches
def right[F[_]:Functor,G[_]](f: F ~> Cofree[G,?]): F ~> G = new (F ~> G) {
def apply[A](as: F[A]) = f(as).tail.map(_.head)
}
// The unit takes `F[A]` to `Cofree[F,A]` for any comonad `F`
// `Cofree` is a monad in the category of comonads.
// The head of the cofree is the counit of the `F` and its tail is `unit` extended over the `F`.
def unit[F[_]:Comonad]: F ~> Cofree[F,A] =
left(NaturalTransformation.identity[F])
// The counit here is the head of the tail.
// Comonad in an endofunctor category
def counit[F[_]]: Cofree[F,A] ~> F =
right(NaturalTransformation.identity[Cofree[F,?]])
}
def mapUnfold[F[_],W[_],A](z: W[A])(f: W ~> F)(implicit W: Comonad[W]): Cofree[F,A]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment