Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Factorial computation with recursion schemes in Scala
import cats.Functor
import cats.implicits._
import scala.language.higherKinds
sealed trait StackR
final case class DoneR(result: Int = 1) extends StackR
final case class MoreR(acc: StackR, next: Int) extends StackR
sealed trait Stack[A]
final case class Done[A](result: Int) extends Stack[A]
final case class More[A](a: A, next: Int) extends Stack[A]
object Stack {
implicit val stackFunctor: Functor[Stack] = new Functor[Stack] {
override def map[A, B](sa: Stack[A])(f: A => B): Stack[B] =
sa match {
case Done(result) => Done(result)
case More(a, next) => More(f(a), next)
}
}
def done[A](result: Int = 1): Stack[A] = Done(result)
def more[A](a: A, next: Int): Stack[A] = More(a, next)
}
sealed trait NatR
case object ZeroR extends NatR
final case class SuccR(prev: NatR) extends NatR
sealed trait Nat[A]
final case class Zero[A]() extends Nat[A]
final case class Succ[A](a: A) extends Nat[A]
object Nat {
implicit val natFunctor: Functor[Nat] = new Functor[Nat] {
override def map[A, B](na: Nat[A])(f: A => B): Nat[B] =
na match {
case Zero() => Zero()
case Succ(a) => Succ(f(a))
}
}
}
final case class Fix[F[_]](unfix: F[Fix[F]])
final case class Cofree[F[_], A](head: A, tail: F[Cofree[F, A]])
sealed trait Free[F[_], A]
final case class Continue[F[_], A](a: A) extends Free[F, A]
final case class Combine[F[_], A](fa: F[Free[F, A]]) extends Free[F, A]
object Free {
def continue[F[_], A](a: A): Free[F, A] = Continue(a)
def combine[F[_], A](fa: F[Free[F, A]]): Free[F, A] = Combine(fa)
}
object RecursionScheme {
import Free._
import Stack._
def unfoldStackR: Int => StackR =
n => if (n > 0) MoreR(unfoldStackR(n - 1), n) else DoneR()
// Type A => F[A] is also known as Coalgebra.
def ana[F[_] : Functor, A](f: A => F[A]): A => Fix[F] =
a => Fix(f(a) map ana(f))
val stackCoalgebra: Int => Stack[Int] =
n => if (n > 0) more(n - 1, n) else done()
// Explicit recursion with StackR
def foldStackR: StackR => Int = {
case DoneR(result) => result
case MoreR(acc, next) => foldStackR(acc) * next
}
// Explicit recursion with Fix[Stack]
def foldFixStack: Fix[Stack] => Int =
_.unfix match {
case Done(result) => result
case More(fix, next) => foldFixStack(fix) * next
}
// Type F[A] => A is also known as Algebra.
def cata[F[_] : Functor, A](f: F[A] => A): Fix[F] => A =
fix => f(fix.unfix map cata(f))
val stackAlgebra: Stack[Int] => Int = {
case Done(result) => result
case More(acc, next) => acc * next
}
def hyloSimple[F[_] : Functor, A, B](f: F[B] => B)(g: A => F[A]): A => B =
ana(g) andThen cata(f)
def hylo[F[_] : Functor, A, B](f: F[B] => B)(g: A => F[A]): A => B =
a => f(g(a) map hylo(f)(g))
def para[F[_] : Functor, A](f: F[(Fix[F], A)] => A): Fix[F] => A =
fix => f(fix.unfix.map(fix => fix -> para(f).apply(fix)))
def cataViaPara[F[_] : Functor, A](f: F[A] => A): Fix[F] => A =
para(((_: F[(Fix[F], A)]).map(_._2)) andThen f)
val natAlgebra: Nat[Int] => Int = {
case Zero() => 1
case Succ(n) => n + 1
}
val natAlgebraPara: Nat[(Fix[Nat], Int)] => Int = {
case Zero() => 1
case Succ((fix, acc)) => cata(natAlgebra).apply(fix) * acc
}
val natCoalgebra: Int => Nat[Int] =
n => if (n == 0) Zero() else Succ(n - 1)
def apo[F[_] : Functor, A](f: A => F[Either[Fix[F], A]]): A => Fix[F] =
a => Fix(f(a) map {
case Left(fix) => fix
case Right(aa) => apo(f).apply(aa)
})
def anaViaApo[F[_] : Functor, A](f: A => F[A]): A => Fix[F] =
apo(f andThen (_.map(_.asRight[Fix[F]])))
val lastThreeSteps: Fix[Stack] = Fix(More(Fix(More(Fix(More(Fix(Done(1)),1)),2)),3))
val stackCoalgebraApo: Int => Stack[Either[Fix[Stack], Int]] =
n => if (n > 3) more(n - 1, n).map(_.asRight) else lastThreeSteps.unfix.map(_.asLeft)
def histo[F[_] : Functor, A](f: F[Cofree[F, A]] => A): Fix[F] => A = {
def toCofree: Fix[F] => Cofree[F, A] =
fix => Cofree(head = histo(f).apply(fix), tail = fix.unfix map toCofree)
fix => f(fix.unfix map toCofree)
}
def dynaSimple[F[_] : Functor, A, B](f: F[Cofree[F, B]] => B)(g: A => F[A]): A => B =
ana(g) andThen histo(f)
def dyna[F[_] : Functor, A, B](f: F[Cofree[F, B]] => B)(g: A => F[A]): A => B = {
val cofree: F[Cofree[F, B]] => Cofree[F, B] =
fc => Cofree(f(fc), fc)
a => hylo(cofree)(g).apply(a).head
}
def futu[F[_] : Functor, A](f: A => F[Free[F, A]]): A => Fix[F] = {
def toFix: Free[F, A] => Fix[F] = {
case Continue(a) => futu(f).apply(a)
case Combine(fa) => Fix(fa map toFix)
}
a => Fix(f(a) map toFix)
}
val firstThreeSteps: Stack[Free[Stack, Int]] = more(combine(more(continue(3), 4)), 5)
val stackCoalgebraFutu: Int => Stack[Free[Stack, Int]] =
n =>
if (n == 5) firstThreeSteps
else if (n > 0) more(n - 1, n) map continue
else done() map continue
}
@zliu41

This comment has been minimized.

Copy link
Owner Author

commented Nov 14, 2017

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.