Free Monadについて

新規性の無い話というものはなかなか話す場所も無いもので、 どこにも話す機会が見つからなかったのでブログに書いて放置しようかと。

Free MonadのApplicative合成

Free MonadはMonadです。 なのでApplicative合成ができます。

Applicative合成ができても直列実行しかできない処理もあるんですが、 Freeは抽象的な内容なので可能なら並列実行したいわけです。

scalazやcatsなどを調べてみると、Freeとは別にFreeApplicativeと呼ばれるクラスがあります。 これらがApplicativeで並列実行可能なように実装されているだけで、 Free側はApplicative合成しても直列化される実装のよう(？)です。

(catsは2.1.1, scalazは7.3.0を使用しています。)

正直、どちらのFreeもすごく難しそうなチューニングがしてあって、 どこがどうなっているのかすらわかりません。

ということで、最適化とかそういう難しいことは考えずに、 最低限の実装でFree Monad + Free Applicativeを実装してみようという話です。

実装

全体のコードはgithubに置いてあります。

開始点

一般的なFreerを出発点とします。

sealed trait Free[F[_], A] {
  def map[B](f: A => B): Free[F, B] = flatMap(f.andThen(Free.pure))
}

object Free {
  final case class Pure[F[_], A](a: A) extends Free[F, A]
  final case class Impure[I, F[_], A](fi: F[I], f: I => F[A]) extends Free[F, A]

  def pure[F[_], A](a: A): Free[F, A] = Pure(a)
}

合成のクラス化

まずは合成の操作がわかりやすくなるようにKleisli部分を別クラスに切り出します。

- final case class Impure[I, F[_], A](fi: F[I], f: I => F[A]) extends Free[F, A]
+ final case class Impure[I, F[_], A](fi: F[I], arrow: Arrow[I, F, A]) extends Free[F, A]

sealed trait Arrow[A, F[_], B] {
  def run(fa: F[A])(implicit M: Monad[F]): F[B]
}

object Arrow {
  final class Bind[A, F[_], B](f: A => Free[F, B]) extends Arrow[A, F, B] {
    override def run(fa: F[A])(implicit M: Monad[F]): F[B] = M.bind(fa)(f)
  }
  final class Sequence[A, X, F[_], B](a1: Arrow[A, F, X], a2: Arrow[X, F, B]) extends Arrow[A, F, B] {
    override def run(fa: F[A])(implicit M: Monad[F]): F[B] = a2.run(a1.run(fa))
  }
}

Monadはなんでも良いのですが、scalaz.Monadを使用しています。

Applicative用のArrowを導入

F[A => B]を合成できるようにArrowにコンストラクターを追加します。

object Arrow {
  // 略
  final case class Apply[A, F[_], B](f: Free[F, A => B]) extends Arrow[A, F, B] {
    override def run(fa: F[A])(implicit M: Monad[F]): F[B] = f match {
      case Free.Pure(ff) => M.map(fa)(ff)
      case Free.Impure(fi, arrow) => M.ap(fa)(arrow.run(fi))
    }
  }
}

fがFreeなので少々厄介ですが、型合わせをすれば動くかと。

きっとここまででも目的は達成していると思うのですが、 この部分のImpureの場合のarrowがほとんどの場合無駄な気がするので専用の型を用意します。

Arrow.Idenittyの導入

とくに何もしないArrowを用意します。 名称はIdentityが正しいのか、reflectが正しいのかわかりませんが、なんとなく前者で。

object Arrow {
  // 略
  final case class Identity[F[_], A]() extends Arrow[A, F, A] {
    override def run(fa: F[A])(implicit M: Monad[F]): F[A] = fa
  }
}

あとはなんかまあ、いい感じに。

テスト実行

わかりやすそうなオブジェクトとしてmonixのTaskで実行してみます。

Utility methodの準備

簡単にthreadを専有できるThread.sleepの出番ですね。

import monix.eval.Task

def task[A](id: String, ms: Long, value: => A): monix.eval.Task[A] = monix.eval.Task {
  try {
    println(s"id: $id started ${Instant.now()}")
    Thread.sleep(ms)
    value
  } finally {
    println(s"id: $id finished ${Instant.now()}")
  }
}

implicit val taskMonad: scalaz.Monad[Task] = new scalaz.Monad[Task] {
  override def ap[A, B](fa: => Task[A])(f: => Task[A => B]): Task[B] = Task.parMap2(fa, f)((a, ff) => ff(a))
  override def apply2
  override def bind[A, B](fa: Task[A])(f: A => Task[B]): Task[B] = fa.flatMap(f)
  override def point[A](a: => A): Task[A] = Task(a)
}

Monad instance

FreeをscalazのMonadに依存するように作ってしまったので、TaskのMonad instanceを準備します。 ついでにFree自身のinstanceも作ってしまいます。

  implicit val taskMonad: scalaz.Monad[Task] = new scalaz.Monad[Task] {
  override def ap[A, B](fa: => Task[A])(f: => Task[A => B]): Task[B] = Task.parMap2(fa, f)((a, ff) => ff(a))
  override def apply2[A, B, C](fa: => Task[A], fb: => Task[B])(f: (A, B) => C): Task[C] = Task.parMap2(fa, fb)(f)
  override def bind[A, B](fa: Task[A])(f: A => Task[B]): Task[B] = fa.flatMap(f)
  override def point[A](a: => A): Task[A] = Task(a)
}

implicit def freeMonad[F[_]: scalaz.Monad]: scalaz.Monad[yafmi.Free[F, *]] = new Monad[yafmi.Free[F, *]] {
  override def ap[A, B](fa: => Free[F, A])(f: => Free[F, A => B]): Free[F, B] = fa.ap(f)
  override def apply2[A, B, C](fa: => Free[F, A], fb: => Free[F, B])(f: (A, B) => C): Free[F, C] =
    fa.map2(fb)(f)
  override def bind[A, B](fa: Free[F, A])(f: A => Free[F, B]): Free[F, B] = fa.flatMap(f)
  override def point[A](a: => A): Free[F, A] = Free.pure(a)
}

実行

簡単なサンプルを実行してみます。

import scala.concurrent.duration.DurationInt
import monix.execution.Scheduler.Implicits.global 

val x = {
  import yafmi.Free
  val a = Free.liftF(task("a", 4000, 42)).flatMap(i => Free.liftF(task("b", 1000, i * 2)))
  val b = Free.liftF(task("c", 3000, 3.14)).flatMap(d => Free.liftF(task("d", 2000, d * 10)))
  val f1: (Int, Double) => Long = (i, d) => (i * d).toLong
  a.map2(b)(f1)
}

x.run.runSyncUnsafe(30.seconds)

id: c started 2020-05-04T12:56:52.614052Z
id: a started 2020-05-04T12:56:52.615491Z
id: c finished 2020-05-04T12:56:55.618629Z
id: d started 2020-05-04T12:56:55.620649Z
id: a finished 2020-05-04T12:56:56.619649Z
id: b started 2020-05-04T12:56:56.620590Z
id: b finished 2020-05-04T12:56:57.625377Z
id: d finished 2020-05-04T12:56:57.625387Z

val res0: Long = 2637

いい感じですね。 ついでにApplicativeBuilderも試しておきましょう。

val y = {
  import yafmi.Free
  import scalaz.syntax.applicative.ToApplyOpsUnapply
  val a = Free.liftF(task("a", 4000, 42)).flatMap(i => Free.liftF(task("b", 1000, i * 2)))
  val b = Free.liftF(task("c", 3000, 3.14)).flatMap(d => Free.liftF(task("d", 2000, d * 10)))
  val f1: (Int, Double) => Long = (i, d) => (i * d).toLong
  (a |@| b)(f1)
}

y.run.runSyncUnsafe(30.seconds)

id: c started 2020-05-04T12:59:04.214376Z
id: a started 2020-05-04T12:59:04.214464Z
id: c finished 2020-05-04T12:59:07.216922Z
id: d started 2020-05-04T12:59:07.217325Z
id: a finished 2020-05-04T12:59:08.219095Z
id: b started 2020-05-04T12:59:08.219483Z
id: d finished 2020-05-04T12:59:09.220411Z
id: b finished 2020-05-04T12:59:09.222420Z

val res1: Long = 2637

次回へ

他の型から変換する例などでも意図通りに動くのか確かめてみたいですね。 今日はここまで。