Scala 版 Extensible Effects 解説 Tree モナド と Choose モナド（List モナド）編

前回 最後に紹介した Extensible Effects の解説サイト、Extensible Effects を理解するのに大変参考になったのだが、2点気になることがあったので勝手に解説＆修正を試みる。

Extensible Effects とは？

複数のモナドをなんつーかこう上手いことする仕組み。
元記事がほんと分かりやすく順を追って説明してくださってるのでそちらをご参考ください。

Tree の定義がいつの間にか変わっている…！

Freer の定義後

Freerを使ってTreeを表現してみましょう。

type Pair[A] = (A, A)

type Tree[A] = Freer[Pair, A]

def leaf[A](a: A): Tree[A] = Pure(a)

def node[A](x: Tree[A], y: Tree[A]): Tree[A] = Freer((x, y): Pair[Tree[A]])

Eff の定義後

Unionの値は次のように作ることができます。

type Tree[A] = (A, A)

type Maybe[A] = Unit

val tree1: Maybe :+: Tree :+: Void = Inr(Inl((0, 1): Tree[Int]))

最初見た時気づかなかったのだがよく見ると Freer の方で Pair と言っていたものがいつの間にか Tree になっている。

Pair の自由モナドが Tree で、他の計算作用と合成する際には Tree ではなくて Pair を合成することになる。ここがモナド変換子と異なる点で、モナド変換子は引数としてモナド（例えば Tree や Maybe）を要請するのに対し、Extensible Effects はまず計算作用（例えば Pair や Const）を用意し、それらの直和型を定義し、それからモナドを構築するのである。

// 計算作用 Const とその自由モナド Maybe
type Const[A] = Unit
final case class MaybeT[F[_], A](run: F[Maybe[A]]) {
  // Maybe は Const の自由モナドだが、モナド変換子の説明のため MaybeT を scalaz から引用
  // 中身 略
}

// 計算作用 Pair とその自由モナド Tree
type Pair[A] = [A, A]
type Tree[A] = Freer[Pair, A]

type MaybeTree1[A] = MaybeT[Tree, A]  // モナド変換子を使って Maybe と Tree を合成

type U = Const :+: Pair :+: Void      // Union を使って Const と Pair の直和型を定義
type MaybeTree2[A] = Eff[U, A]        // 直和型の自由モナドとして Maybe と Tree の合成を表現

モナドを合成するものと思っていたので、はじめ Tree が Pair になっていることに気づかなかった。

Tree の fold 関数、間違っている気が…

これらを用いてTreeモナドは次のように定義されます。

def leaf[U <: Union, A](a: A)(implicit member: Member[Tree, U]): Eff[U, A] = Pure(a)

def node[U <: Union, A](x: Eff[U, A], y: Eff[U, A])(implicit member: Member[Tree, U]): Eff[U, A] = Eff((x, y): Tree[Eff[U, A]])

def fold[U <: Union, A, B](t: Eff[Tree :+: U, A])(f: A => B)(g: (B, B) => B): Eff[U, B] =
  t match {
    case Pure(a) => Pure(f(a))
    case Impure(u, h) =>
      def k(t: Tree[Any]): Eff[U, B] =
        t match {
          case (x, y) =>
            for {
              a <- fold(h(x))(f)(g)
              b <- fold(h(y))(f)(g)
            } yield g(a, b)
        }
      u match {
        case Inl(t) => k(t)
        case Inr(u) => Impure(u, Leaf(k))
      }
  }

def str[U <: Union, A, B](t: Eff[Tree :+: U, A]): Eff[U, String] = fold(t)(_.toString)((x, y) => s"($x, $y)")

複数箇所で同じ引数を使っているのが若干見づらいので、変数名を変えてみる（ついでに Tree → Pair に変えてみる）。

type Pair[A] = (A, A)
def leaf[U <: Union, A](a: A)(implicit member: Member[Pair, U]): Eff[U, A] = Pure(a)

def node[U <: Union, A](x: Eff[U, A], y: Eff[U, A])(implicit member: Member[Pair, U]): Eff[U, A] = Eff((x, y): Pair[Eff[U, A]])

def fold[U <: Union, A, B](t: Eff[Pair :+: U, A])(f: A => B)(g: (B, B) => B): Eff[U, B] =
  t match {
    case Pure(a) => Pure(f(a))
    case Impure(u, h) =>
      def k(pair: Pair[Any]): Eff[U, B] =
        pair match {
          case (x, y) =>
            for {
              a <- fold(h(x))(f)(g)
              b <- fold(h(y))(f)(g)
            } yield g(a, b)
        }
      u match {
        case Inl(l) => k(l)
        case Inr(r) => Impure(r, Leaf(k))
      }
  }

def str[U <: Union, A, B](t: Eff[Pair :+: U, A]): Eff[U, String] = fold(t)(_.toString)((x, y) => s"($x, $y)")

何がおかしいかを説明するために、 Freer と Eff の定義を引用する（変数名は説明のため若干変えている）。

// Freer
sealed trait Freer[F[_], A] { ... }
case class Pure[F[_], A](a: A) extends Freer[F, A]
case class Impure[F[_], X, A](fx: F[X], f: X => Freer[F, A]) extends Freer[F, A]

// Eff
sealed trait Eff[U <: Union, A] { ... }
case class Pure[U <: Union, A](a: A) extends Eff[U, A]
case class Impure[U <: Union, X, A](u: U, f: Arrows[U, X, A]) extends Eff[U, A]

Freer の Impure は第１引数に F[X] 型の値 fxを取る。一方 Eff では複数の計算作用の直和である U の値 u を取る。型 U は複数の計算作用の直和であるから、その具体的な値は複数の計算作用の「どれか」 ということになり、u も瞬間瞬間ではある計算作用 F を使って F[X] という形で表せる。
第２引数は Freer も Eff も同じで、X 型の値を受け取って、 Freer[F, A] 型または Eff[U, A] 型を返す関数、を表している。

つまり Eff の定義だけを見たのではとてもわかりづらいが、あくまで第２引数は「第１引数の計算結果を受けて、その後に実行される予定の関数」を表しており、Arrows[U, X, A] の X は u がある計算作用を使って F[X] とあらわされた時の X と一致している必要がある。

ここまで確認したあとで、もう一度 Tree モナドの fold の定義を見てみる。

def fold[U <: Union, A, B](t: Eff[Pair :+: U, A])(f: A => B)(g: (B, B) => B): Eff[U, B] =
  t match {
    case Pure(a) => Pure(f(a))
    case Impure(u, h) =>
      def k(pair: Pair[Any]): Eff[U, B] =
        pair match {
          case (x, y) =>
            for {
              a <- fold(h(x))(f)(g)
              b <- fold(h(y))(f)(g)
            } yield g(a, b)
        }
      u match {
        case Inl(l) => k(l)
        case Inr(r) => Impure(r, Leaf(k))
      }
  }

t は Eff[Pair :+: U, A] 型で、これは Pure[Pair :+: U, A] か Impure[Pair :+: U, X, A] のどちらかである。

    case Pure(a) => Pure(f(a))

Pure(a) という形だった場合は、f(a) を計算して Pure に入れ直している。
左側の Pure は Pure[Pair :+: U, A] 型であるのに対し、右側は Pure[U, B] 型であるのに注意。

一方 Impure[Pair :+: U, X, A だった場合

    case Impure(u, h) =>

として impure の持つ値を取り出している。この時

• u の型は Pair :+: U
• h の型は Arrows[Pair :+: U, X, A] つまり X => Eff[Pair :+: U, A] という関数である。

次に k という関数を定義し、これを２箇所で使っている。この関数の型は Pair[Any] => Eff[U, B] である。

最後に、u（Pair :+: U） の場合分けでこの関数は終わる。

u が Inl(l) だった場合、
l の型は Pair[X] という型である。 X がどんな型なのかは分からないが、k は Pair[Any] を受け取るので渡すことが出来る（Tuple の共変性を使っている）
k(l) の型は Eff[U, B] であり、戻り値として返す事ができる。

u が Inr(r) だった場合
r の型は U であり、他にどんな計算作用があるかわからないが、 F[X] という形をした型で表すことが出来る。
この r を使って Impure(r, Leaf(k)) という値を作り、これを返している。
Leaf(k) は Arrows 型を作るコンストラクタで、k の型が Pair[Any] => Eff[U, B] であったから、Leaf(k) の型は Arrows[U, Pair[Any], B] となる。

ちょっと待って。 r を F[X] という形で表した時の X と、 Leaf(k) の型に出てくる X つまり Pair[Any] って必ず一致するのだろうか。ここが一致しないと、計算の途中で型エラーが起きてしまう。

実際、これは必ずしも成り立たない。そのことを確かめるために、Choose モナドというのを作ってみる。

sealed trait Choose[T]
object Choose {
  private[this] case class ConcreteChoose[A, T](as: Vector[A], f: A => T) extends Choose[T]

  def apply[U <: Union, A](as: A*)(
    implicit m: Member[Choose, U]
  ): Eff[U, A] =
    Eff(ConcreteChoose(as.toVector, {(a: A) => Pure(a)}): Choose[Eff[U, A]]

  def makeChoice[U <: Union, A](
    e: Eff[Choose :+: U, A]
  ): Eff[U, Vector[A]] = e match {
    case Pure(a) => Pure(Vector(a))
    case Impure(Inl(ConcreteChoose(xs, f)), h) =>
      xs.toIterator
        .map(f)
        .map(h(_))
        .map(makeChoice)
        .foldLeft(Pure(Vector.empty): Eff[U, Vector[A]]){
          (bEff: Eff[U, Vector[A]], aEff: Eff[U, Vector[A]]) => for {
            bs <- bEff
            as <- aEff
          } yield bs ++ as
        }
      case Impure(Inr(u), h) =>
        Impure(u, Leaf((x: Any) => makeChoice(h(x))))
}

Choose モナドはこんな風に使う。

def e[U <: Union](implicit m: Member[Choose, U]): Eff[U, Int] = for {
  a <- Choose(10, 20, 30)
  b <- Choose(1, 2, 3)
} yield a + b

Eff.run(Choose.makeChoice(e[Choose :+: Void]))
// Vector(11, 12, 13, 21, 22, 23, 31, 32, 33)

Tree モナドと組み合わせてみよう。

def e[U <: Union](
  implicit mp: Member[Pair, U], mc: Member[Choose, U]
): Eff[U, Int] = for {
  a <- node(leaf(10), leaf(20))
  b <- Choose(1, 2, 3)
} yield a + b

Eff.run(Choose.makeChoice(str(e[Pair :+: Choose :+: Void])))

/*
java.lang.ClassCastException: amo.app.eff.Pure cannot be cast to scala.Tuple2
  at amo.app.eff.Arrows.go$2(Arrows.scala:28)
  at amo.app.eff.Arrows.apply(Arrows.scala:33)
  at amo.app.eff.Arrows.apply$(Arrows.scala:23)
  at amo.app.eff.Node.apply(Arrows.scala:41)
  at amo.app.example.Choose$.$anonfun$makeChoice$1(Choose.scala:50)
  at scala.collection.Iterator$$anon$10.next(Iterator.scala:448)
  at scala.collection.Iterator$$anon$10.next(Iterator.scala:448)
  at scala.collection.Iterator.foreach(Iterator.scala:929)
  at scala.collection.Iterator.foreach$(Iterator.scala:929)
  at scala.collection.AbstractIterator.foreach(Iterator.scala:1406)
  at scala.collection.TraversableOnce.foldLeft(TraversableOnce.scala:157)
  at scala.collection.TraversableOnce.foldLeft$(TraversableOnce.scala:155)
  at scala.collection.AbstractIterator.foldLeft(Iterator.scala:1406)
  at amo.app.example.Choose$.makeChoice(Choose.scala:54)
  ... 39 elided
 */

Pure を Tuple (つまり Pair) に cast 出来ないよ、と言われている。
元記事で同時に紹介されている Maybe モナドは Impure （つまり None） だった場合あとの処理を破棄するので、このエラーは出ない。

Tree の fold を修正してみよう。

def fold[U <: Union, A, B](
  t: Eff[Pair :+: U, A]
)(f: A => B)(g: (B, B) => B): Eff[U, B] = t match {
  case Pure(a) => Pure(f(a))
  case Impure(Inl((x, y)), h) => for {
    a <- fold(h(x))(f)(g)
    b <- fold(h(y))(f)(g)
  } yield g(a, b)
  case Impure(Inr(u), h) =>
    Impure(u, Leaf((x: Any) => fold(h(x))(f)(g)))
}

まずImpure の保持する値が Inl((x, y)) だった場合、これは元記事と同じやり方で Tree を外すことが出来る。
Inr(u) だった場合、その中身に対して h を実行してやる（h(x)）。この実行結果の型は Eff[Pair :+: U, A] であるから、これに対してあらためて fold を実行し、その結果をそのまま使用している。

今度はうまく行く。

Eff.run(Choose.makeChoice(str(e[Pair :+: Choose :+: Void])))
// Vector((11, 21), (11, 22), (11, 23), (12, 21), (12, 22), (12, 23), (13, 21), (13, 22), (13, 23))
// 先に Tree を String に変換してから makeChoice を実行
// 存在しうる Tree のリストが得られる。

Eff.run(str(Choose.makeChoice(e[Choose :+: Pair :+: Void])))
// (Vector(11, 12, 13), Vector(21, 22, 23))
// 先に makeChoice を実行してから String に変換
// Tree の各 leaf が、取り得る値候補のリストになっている