Sample implementation

recursionSchemes.scala

package Other

import scalaz.Functor

import scala.language.higherKinds

object exampleList {
  
  sealed trait mList
  case object mNil extends mList
  case class mCons(head: Int, tail: mList) extends mList
  
  object mList {
    def foldList[A](onNil: A, onCons: (Int, A) => A): mList => A = {
      case `mNil`      => onNil
      case mCons(h, t) => onCons(h, foldList(onNil, onCons)(t))
    }
    
    def length(ls: mList): Int = foldList[Int](0, (_, len) => len + 1)(ls)
    def prettyPrint(ls: mList): String = foldList[String]("Nil", (h, s) => s"$h :: " + s)(ls)
    def multiply(ls: mList): Long = foldList[Long](1, (h, product) => h * product)(ls)
  }
  
  import mList._
  
  val data = mCons(3, mCons(4, mCons(5, mCons(6, mNil))))
  prettyPrint(data)
  length(data)
  multiply(data)
}

object recursionSchemes extends App {
  /*------Recursion Schemes------------*/
  type Coalgebra[F[_], A] = A => F[A]
  type Falgebra[F[_], A] = F[A] => A
  
  // Generic Sum Type Structure
  sealed trait ListF[_]
  case class NilF[A]() extends ListF[A]
  case class ConsF[A](head: Int, tail: A) extends ListF[A]
  
  // implicit Functor instance for generic structure
  implicit val listFFunctor: Functor[ListF] = new Functor[ListF] {
    override def map[A, B](fa: ListF[A])(f: A => B): ListF[B] = {
      fa match {
        case NilF() => NilF()
        case ConsF(h, a) => ConsF(h, f(a))
      }
    }
  }

  //Recursion schemes for generic recursive structure
  object Schemes {
    def cata[F[_], R, A](out: R => F[R], algebra: F[A] => A)(r: R)
                        (implicit F: Functor[F]): A = algebra(F.map(out(r))(cata(out, algebra)))
  
    def ana[F[_], R, A](in: F[R] => R, coalgebra: A => F[A])(a: A)
                       (implicit F: Functor[F]): R = in(F.map(coalgebra(a))(ana(in, coalgebra)))
  
    def hylo[F[_], A, B](coalgebra: A => F[A],
                         algebra: F[B] => B)(a: A)
                        (implicit F: Functor[F]): B = algebra(F.map(coalgebra(a))(hylo(coalgebra, algebra)))
  }
  
  //Concrete ListF F-Algebra Implementations
  object ListFAlgebra {
    def multiplyAlgebra: Falgebra[ListF, BigInt] = {
      case NilF() => 1
      case ConsF(h, t) => h * t
    }
    
    def stringAlebgra: Falgebra[ListF, String] = {
      case NilF() => "Nil"
      case ConsF(h, t) => s"$h :: " + t
    }
    
    def lengthAlgebra: Falgebra[ListF, Int] = {
      case NilF() => 0
      case ConsF(_, t) => t + 1
    }
  }
  
  object ListFCoalgebra {
    def charCoalgebra: Coalgebra[ListF, Char] = {
      case a if a.toInt >= 128 => NilF()
      case b => ConsF(b, (b.toInt + 1).toChar)
    }
    
    def intCoalgebra: Coalgebra[ListF, Int] = {
      case n if n <= 0 => NilF()
      case n => ConsF(n, n - 1)
    }
  }
  
  import exampleList._
  object ListF {

    import Schemes._
    import ListFAlgebra._
    import ListFCoalgebra._
    
    // specific implementations of a morphism in an out of the alegbra
    def in: ListF[mList] => mList = {
      case NilF() => mNil
      case ConsF(h, t) => mCons(h, t)
    }
    
    def out: mList => ListF[mList] = {
      case mCons(h, t) => ConsF(h, t)
      case _ => NilF[mList]()
    }
    
    // catamorphisms
    def catas[A](algebra: Falgebra[ListF, A]): mList => A = cata(out, algebra)
    
    def multiply: mList => BigInt = catas(multiplyAlgebra)
    def prettyPrint: mList => String = catas(stringAlebgra)
    def length: mList => Int = catas(lengthAlgebra)
    
    // anamorphisms
    def anas[A](coalgebra: Coalgebra[ListF, A]): A => mList = ana(in, coalgebra)
    
    def rangeChar[A]: Char => mList = anas(charCoalgebra)
    def rangeInt[A]: Int => mList = anas(intCoalgebra)
    
    // hylomorphism
    def factorialHylo: Int => BigInt = hylo(intCoalgebra, multiplyAlgebra)
  
    // Enrichment classes
    implicit class mListCataOps(data: mList) {
      def product = multiply(data)
      def mkString = prettyPrint(data)
      def size = length(data)
    }
  
    implicit class intOps(int: Int) {
      def range = rangeInt(int)
      def factorial = factorialHylo(int)
    }
    
    implicit class charOps(char: Char) {
      def range = rangeChar(char)
    }
  }
  
  object RecursionSchemeUsage {
    import ListF._
  
    val data = mCons(3, mCons(4, mCons(5, mCons(6, mNil))))
    data.mkString
    data.product
    data.size
  
    val char = 'Z'
    val int = 25
  
    println(char.range.mkString)
    println(int.range.mkString)
    println(int.factorial)
  }
  
  object fixPoint {
    // Fix Point definition
    case class Fix[F[_]](unfix: F[Fix[F]])
    
    object FixpointSchemes {
      def cata[F[_], A](algebra: F[A] => A)(r: Fix[F])
                       (implicit F: Functor[F]): A = algebra(F.map(r.unfix)(cata(algebra)))
    
      def ana[F[_], A](coalgebra: A => F[A])(a: A)
                      (implicit F: Functor[F]): Fix[F] = Fix(F.map(coalgebra(a))(ana(coalgebra)))
      
      def hylo[F[_], A, B](coalgebra: A => F[A], algebra: F[B] => B)(r: A)
                        (implicit F: Functor[F]): B = algebra(F.map(coalgebra(r))(hylo(coalgebra, algebra)))
    }
    
    //Same algebras
    import ListFAlgebra._
    import ListFCoalgebra._
    
    import FixpointSchemes._
    
    def fixMultiply: Fix[ListF] => BigInt = cata(multiplyAlgebra)
    def fixPrettyPrint: Fix[ListF] => String = cata(stringAlebgra)
    def fixLength: Fix[ListF] => Int = cata(lengthAlgebra)
    
    def fixIntRange: Int => Fix[ListF] = ana(intCoalgebra)
    def fixCharRange: Char => Fix[ListF] = ana(charCoalgebra)
    
    def fixFactorial: Int => BigInt = hylo(intCoalgebra, multiplyAlgebra)
  
    implicit class fixCataOps(data: Fix[ListF]) {
      def product = fixMultiply(data)
      def mkString = fixPrettyPrint(data)
      def size = fixLength(data)
    }
  
    implicit class fixIntOps(int: Int) {
      def range = fixIntRange(int)
      def factorial = fixFactorial(int)
    }
  
    implicit class fixCharOps(char: Char) {
      def range = fixIntRange(char)
    }
  }
  
  import fixPoint._
  val fixData = Fix[ListF](ConsF(1, Fix(ConsF(2, Fix(ConsF(10, Fix(ConsF(-2, Fix(NilF())))))))))
  
  //catas
  println(fixData.product)
  println(fixData.mkString)
  println(fixData.size)
  
  //anas
  val fixInt = 20
  val fixChar = 'Z'
  println(fixInt.range.mkString)
  println(fixChar.range.mkString)
  
  //hylo
  println(fixInt.factorial)
  
  object treeExample {
    // Generic Sum Type Structure
    sealed trait TreeF[_]
    case class LeafF[A](a: Int) extends TreeF[A]
    case class BranchF[A](left: A, right: A) extends TreeF[A]
  
    // implicit Functor instance for generic structure
    implicit val treeFFunctor: Functor[TreeF] = new Functor[TreeF] {
      override def map[A, B](fa: TreeF[A])(f: A => B): TreeF[B] = {
        fa match {
          case LeafF(a) => LeafF(a)
          case BranchF(l, r) => BranchF(f(l), f(r))
        }
      }
    }
    
    object TreeFAlgebra {
      def lengthAlgebra: Falgebra[TreeF, Int] = {
        case LeafF(a) => 1
        case BranchF(l, r) => l + r
      }
      
      def sumAlgebra: Falgebra[TreeF, Int] = {
        case LeafF(a) => a
        case BranchF(l, r) => l + r
      }
    }
    
    import fixPoint._
    
    object TreeF {
      import FixpointSchemes._
      
      def size: Fix[TreeF] => Int = cata(TreeFAlgebra.lengthAlgebra)
      def sum: Fix[TreeF] => Int = cata(TreeFAlgebra.sumAlgebra)
    }
  }
  
  import treeExample._
  
  val data = Fix[TreeF](
    BranchF(
      Fix(BranchF(Fix(LeafF(4)),
        Fix(LeafF(5)))),
      Fix(BranchF(Fix(LeafF(2)),
        Fix(LeafF(7))))))
  
  println(TreeF.size(data))
  println(TreeF.sum(data))
}