モナドを作る 

LYAHFGG:

この節では、型が生まれてモナドであると確認され、適切な Monad インスタンスが与えられるまでの過程を、例題を通して学ぼうと思います。 … [3,5,9] のような非決定的値を表現したいのだけど、さらに 3 である確率は 50パーセント、5 と 9 である確率はそれぞれ 25パーセントである、ということを表したくなったらどうしましょう？

Scala に有理数が標準で入っていないので、Double を使う。以下が case class:

import cats._, cats.syntax.all._

case class Prob[A](list: List[(A, Double)])

trait ProbInstances {
  implicit def probShow[A]: Show[Prob[A]] = Show.fromToString
}

case object Prob extends ProbInstances

これってファンクターでしょうか？ええ、リストはファンクターですから、リストに何かを足したものである Prob もたぶんファンクターでしょう。

case class Prob[A](list: List[(A, Double)])

trait ProbInstances {
  implicit val probInstance: Functor[Prob] = new Functor[Prob] {
    def map[A, B](fa: Prob[A])(f: A => B): Prob[B] =
      Prob(fa.list map { case (x, p) => (f(x), p) })
  }
  implicit def probShow[A]: Show[Prob[A]] = Show.fromToString
}

case object Prob extends ProbInstances

Prob((3, 0.5) :: (5, 0.25) :: (9, 0.25) :: Nil) map { -_ }
// res1: Prob[Int] = Prob(list = List((-3, 0.5), (-5, 0.25), (-9, 0.25)))

本と同様に flatten をまず実装する。

case class Prob[A](list: List[(A, Double)])

trait ProbInstances {
  def flatten[B](xs: Prob[Prob[B]]): Prob[B] = {
    def multall(innerxs: Prob[B], p: Double) =
      innerxs.list map { case (x, r) => (x, p * r) }
    Prob((xs.list map { case (innerxs, p) => multall(innerxs, p) }).flatten)
  }

  implicit val probInstance: Functor[Prob] = new Functor[Prob] {
    def map[A, B](fa: Prob[A])(f: A => B): Prob[B] =
      Prob(fa.list map { case (x, p) => (f(x), p) })
  }
  implicit def probShow[A]: Show[Prob[A]] = Show.fromToString
}

case object Prob extends ProbInstances

これでモナドのための準備は整ったはずだ:

import scala.annotation.tailrec

case class Prob[A](list: List[(A, Double)])

trait ProbInstances { self =>
  def flatten[B](xs: Prob[Prob[B]]): Prob[B] = {
    def multall(innerxs: Prob[B], p: Double) =
      innerxs.list map { case (x, r) => (x, p * r) }
    Prob((xs.list map { case (innerxs, p) => multall(innerxs, p) }).flatten)
  }

  implicit val probInstance: Monad[Prob] = new Monad[Prob] {

    def pure[A](a: A): Prob[A] = Prob((a, 1.0) :: Nil)

    def flatMap[A, B](fa: Prob[A])(f: A => Prob[B]): Prob[B] = self.flatten(map(fa)(f))

    override def map[A, B](fa: Prob[A])(f: A => B): Prob[B] =
      Prob(fa.list map { case (x, p) => (f(x), p) })

    def tailRecM[A, B](a: A)(f: A => Prob[Either[A, B]]): Prob[B] = {
      val buf = List.newBuilder[(B, Double)]

      @tailrec def go(lists: List[List[(Either[A, B], Double)]]): Unit =
        lists match {
          case (ab :: abs) :: tail => ab match {
            case (Right(b), p) =>
              buf += ((b, p))
              go(abs :: tail)
            case (Left(a), p) =>
              go(f(a).list :: abs :: tail)
          }
          case Nil :: tail => go(tail)
          case Nil => ()
        }
      go(f(a).list :: Nil)
      Prob(buf.result)
    }
  }

  implicit def probShow[A]: Show[Prob[A]] = Show.fromToString
}

case object Prob extends ProbInstances

本によるとモナド則は満たしているらしい。Coin の例題も実装してみよう:

sealed trait Coin

object Coin {
  case object Heads extends Coin
  case object Tails extends Coin
  implicit val coinEq: Eq[Coin] = new Eq[Coin] {
    def eqv(a1: Coin, a2: Coin): Boolean = a1 == a2
  }
  def heads: Coin = Heads
  def tails: Coin = Tails
}

import Coin.{heads, tails}

def coin: Prob[Coin] = Prob(heads -> 0.5 :: tails -> 0.5 :: Nil)

def loadedCoin: Prob[Coin] = Prob(heads -> 0.1 :: tails -> 0.9 :: Nil)

flipThree の実装はこうなる:

def flipThree: Prob[Boolean] = for {
  a <- coin
  b <- coin
  c <- loadedCoin
} yield { List(a, b, c) forall {_ === tails} }

flipThree
// res4: Prob[Boolean] = Prob(
//   list = List(
//     (false, 0.025),
//     (false, 0.225),
//     (false, 0.025),
//     (false, 0.225),
//     (false, 0.025),
//     (false, 0.225),
//     (false, 0.025),
//     (true, 0.225)
//   )
// )

イカサマのコインを 1つ使っても 3回とも裏が出る確率はかなり低いことが分かった。