Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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]
Add Comment
Please, Sign In to add comment