Arrow (Kleisli) で List モナド - Haskell, Frege, Scalaz

Scalaz でリストモナド - Kleisli による関数合成 」等で試してきた List モナドを使ったチェスのナイト移動の処理を Arrow (Kleisli) を使って実装し直してみました。

Arrow は計算のための汎用的なインターフェースで、モナドを扱うための Arrow として Kleisli があります。

ソースは http://github.com/fits/try_samples/tree/master/blog/20140810/

Haskell の場合

Haskell の Arrow は >>><<< で合成できるようになっています。

Kleisli はモナドを扱うための Arrow なので、下記では List モナドを返す関数 moveKnight を Kleisli へ包んで合成しています。

Kleisli から包んだ関数を取り出すには runKleisli を使います。

3手版

まずは 3手版です。

以前の List モナド版との違いは in3canReachIn3 関数を Arrow で実装し直した点です。

Kleisli を使えば、モナド値が無くてもモナドを返す関数 (通常の値を取ってモナドを返す関数) を簡単に合成できるので in3 はポイントフリースタイルで定義しました。 (このため canReachIn3 関数の引数の順序が 以前のもの と異なっています)

また、通常の関数は Arrow のインスタンスなので、canReachIn3 関数の部分は単純に canReachIn3 end = runKleisli in3 >>> elem end とする事も可能です。

move_knight.hs
import Control.Arrow

type KnightPos = (Int, Int)

moveKnight :: KnightPos -> [KnightPos]
moveKnight (c, r) = filter onBoard
    [
        (c + 2, r - 1), (c + 2, r + 1),
        (c - 2, r - 1), (c - 2, r + 1),
        (c + 1, r - 2), (c + 1, r + 2),
        (c - 1, r - 2), (c - 1, r + 2)
    ]
    where onBoard (c', r') = c' `elem` [1..8] && r' `elem` [1..8]

-- 3手先の移動位置を列挙
in3 :: Kleisli [] KnightPos KnightPos
in3 = Kleisli moveKnight >>> Kleisli moveKnight >>> Kleisli moveKnight

-- 指定位置に3手で到達できるか否かを判定
canReachIn3 :: Arrow a => KnightPos -> a KnightPos Bool
canReachIn3 end = arr (runKleisli in3) >>> arr (elem end)
-- 以下でも可
-- canReachIn3 :: KnightPos -> KnightPos -> Bool
-- canReachIn3 end = runKleisli in3 >>> elem end

main = do
    print $ runKleisli in3 $ (6, 2)

    print $ canReachIn3 (6, 1) $ (6, 2)
    print $ canReachIn3 (7, 3) $ (6, 2)
実行結果
> runghc move_knight.hs

[(8,1),(8,3),・・・
・・・
,(3,4),(3,8)]
True
False

N手版

3手版と同様に inManycanReachInMany 関数を Arrow で実装し直してみました。

move_knight_many.hs
・・・
-- N手先の移動位置を列挙
inMany :: Int -> Kleisli [] KnightPos KnightPos
inMany x = foldr (>>>) returnA (replicate x (Kleisli moveKnight))

-- 指定位置にN手で到達できるか否かを判定
canReachInMany :: Arrow a => Int -> KnightPos -> a KnightPos Bool
canReachInMany x end = arr (runKleisli (inMany x)) >>> arr (elem end)
-- 以下でも可
-- canReachInMany :: Int -> KnightPos -> KnightPos -> Bool
-- canReachInMany x end = runKleisli (inMany x) >>> elem end

main = do
    print $ runKleisli (inMany 3) $ (6, 2)

    print $ canReachInMany 3 (6, 1) $ (6, 2)
    print $ canReachInMany 3 (7, 3) $ (6, 2)
実行結果
> runghc move_knight_many.hs

[(8,1),(8,3),・・・
・・・
,(3,4),(3,8)]
True
False

Frege の場合

Frege は Haskell とほとんど同じ実装になりますが、下記の点が異なります。

  • >>> の代わりに . で Arrow を合成
  • runKleisli の代わりに run を使用

なお、.>>> と合成の向きが異なります。

3手版

3手版です。

move_knight.fr
package sample.MoveKnight where

import frege.control.Arrow
import frege.control.arrow.Kleisli

type KnightPos = (Int, Int)

moveKnight :: KnightPos -> [KnightPos]
moveKnight (c, r) = filter onBoard
    [
        (c + 2, r - 1), (c + 2, r + 1),
        (c - 2, r - 1), (c - 2, r + 1),
        (c + 1, r - 2), (c + 1, r + 2),
        (c - 1, r - 2), (c - 1, r + 2)
    ]
    where onBoard (c', r') = c' `elem` [1..8] && r' `elem` [1..8]

-- 3手先の移動位置を列挙
in3 :: Kleisli [] KnightPos KnightPos
in3 = Kleisli moveKnight . Kleisli moveKnight . Kleisli moveKnight

-- 指定位置に3手で到達できるか否かを判定
canReachIn3 :: Arrow a => KnightPos -> a KnightPos Bool
canReachIn3 end = arr (elem end) . arr in3.run
-- 以下でも可
-- canReachIn3 :: KnightPos -> KnightPos -> Bool
-- canReachIn3 end = elem end . in3.run

main args = do
    println $ in3.run $ (6, 2)

    println $ canReachIn3 (6, 1) $ (6, 2)
    println $ canReachIn3 (7, 3) $ (6, 2)
実行結果
> java -jar frege3.21.586-g026e8d7.jar move_knight.fr
・・・
> java -cp .;frege3.21.586-g026e8d7.jar sample.MoveKnight

[(8, 1), (8, 3), ・・・
・・・
 (3, 4), (3, 8)]
true
false

N手版

N手版です。

move_knight_many.fr
package sample.MoveKnightMany where

・・・
-- N手先の移動位置を列挙
inMany :: Int -> Kleisli [] KnightPos KnightPos
inMany x = foldr (.) id (replicate x (Kleisli moveKnight))

-- 指定位置にN手で到達できるか否かを判定
canReachInMany :: Arrow a => Int -> KnightPos -> a KnightPos Bool
canReachInMany x end = arr (elem end) . arr (inMany x).run
-- 以下でも可
-- canReachInMany :: Int -> KnightPos -> KnightPos -> Bool
-- canReachInMany x end = elem end . (inMany x).run

main args = do
    println $ (inMany 3).run $ (6, 2)

    println $ canReachInMany 3 (6, 1) $ (6, 2)
    println $ canReachInMany 3 (7, 3) $ (6, 2)
実行結果
> java -jar frege3.21.586-g026e8d7.jar move_knight_many.fr
・・・
> java -cp .;frege3.21.586-g026e8d7.jar sample.MoveKnightMany

[(8, 1), (8, 3), ・・・
・・・
 (3, 4), (3, 8)]
true
false

Scalaz の場合

最後に Scalaz を使った Scala による実装です。
Haskell と同様に >>> で Arrow を合成できるようになっています。

3手版

3手版です。

MoveKnight.scala
package sample

import scalaz._
import Scalaz._

object MoveKnight extends App {

    type KnightPos = Tuple2[Int, Int]

    val inRange = (p: Int) => 1 to 8 contains p

    val moveKnight = (p: KnightPos) => List(
        (p._1 + 2, p._2 - 1), (p._1 + 2, p._2 + 1),
        (p._1 - 2, p._2 - 1), (p._1 - 2, p._2 + 1),
        (p._1 + 1, p._2 - 2), (p._1 + 1, p._2 + 2),
        (p._1 - 1, p._2 - 2), (p._1 - 1, p._2 + 2)
    ).filter { case (x, y) => inRange(x) && inRange(y) }

    // 3手先の移動位置を列挙
    val in3 = Kleisli(moveKnight) >>> Kleisli(moveKnight) >>> Kleisli(moveKnight)
    // 以下でも可
    // val in3 = Kleisli(moveKnight) >==> moveKnight >==> moveKnight

    // 指定位置に3手で到達できるか否かを判定
    val canReachIn3 = (end: KnightPos) => in3.run >>> { xs => xs.contains(end) }

    in3 (6, 2) |> println

    (6, 2) |> canReachIn3 (6, 1) |> println
    (6, 2) |> canReachIn3 (7, 3) |> println
}
実行結果
> gradle run

MoveKnight
:compileJava UP-TO-DATE
:compileScala UP-TO-DATE
:processResources UP-TO-DATE
:classes UP-TO-DATE
:run
List((8,1), (8,3), ・・・
・・・
・・・, (3,4), (3,8))
true
false

N手版

N手版です。

MoveKnightMany.scala
package sample

import scalaz._
import Scalaz._

object MoveKnightMany extends App {
    ・・・
    // N手先の移動位置を列挙
    val inMany = (x: Int) => List.fill(x) { Kleisli(moveKnight) }.reduce { (a, b) => a >>> b }
    // 以下でも可
    // val inMany = (x: Int) => List.fill(x) { Kleisli(moveKnight) }.reduce { (a, b) => a >=> b }

    // 指定位置にN手で到達できるか否かを判定
    val canReachInMany = (x: Int) => (end: KnightPos) => inMany(x).run >>> { xs => xs.contains(end) }

    (6, 2) |> inMany(3) |> println

    (6, 2) |> canReachInMany(3)(6, 1) |> println
    (6, 2) |> canReachInMany(3)(7, 3) |> println
}
実行結果
> gradle run -Pmany

MoveKnightMany
:compileJava UP-TO-DATE
:compileScala UP-TO-DATE
:processResources UP-TO-DATE
:classes UP-TO-DATE
:run
List((8,1), (8,3), ・・・
・・・
・・・, (3,4), (3,8))
true
false

なお、ビルドと実行には下記のような Gradle ビルド定義ファイルを使用しました。

build.gradle
apply plugin: 'application'
apply plugin: 'scala'

repositories {
    mavenCentral()
}

dependencies {
    compile 'org.scala-lang:scala-library:2.11.2'
    compile 'org.scalaz:scalaz-core_2.11:7.1.0'
}

if (!hasProperty('many')) {
    println 'MoveKnight'
    mainClassName = 'sample.MoveKnight'
}
else {
    println 'MoveKnightMany'
    mainClassName = 'sample.MoveKnightMany'
}

Scalaz で Codensity モナド

Scalaz の Codensity を試してみました。

Codensity モナドは継続モナドと基本的に同じですが、処理の型が以下のように異なっています。

継続モナドの場合 Codensityモナドの場合
(A => R) => R (A => F[B]) => F[B]

つまり、Codensity は何らかのコンテナ(List・Option 等)で包んだ値(上記の F[B] に該当)を返します。

処理結果をモナド化する用途等に使えそうですが、効果的なサンプルを思いつかなかったので、
とりあえずは id:fits:20121125 の継続モナドのサンプルと同等のものを実装してみました。


サンプルソースは http://github.com/fits/try_samples/tree/master/blog/20121222/


今回使用した sbt 用のビルドファイルは以下の通りです。

build.sbt
scalaVersion := "2.10.0-RC5"

libraryDependencies += "org.scalaz" % "scalaz-core" % "7.0.0-M6" cross CrossVersion.full

Codensity の単純なサンプル

まずは、Codensity のメソッドをいくつか試してみます。

Codensity はトレイトとコンパニオンオブジェクトからなるシンプルな構成で、id:fits:20121125 で作成した継続モナドの runCont に該当するのが apply メソッドです。

また、以下のようなメソッドが Codensity コンパニオンオブジェクトに用意されています。

メソッド名 処理内容
pureCodensity 普通の値から Codensity を作成
rep 値を格納したコンテナから Codensity を作成

下記サンプルの (1) 〜 (3) では apply の結果として Function0[Unit] ・ List[Int] ・ Option[Int] をそれぞれ返すようにしてみました。 println(x)" の部分が Function0[Unit] に該当">*1

以降のサンプルでは Codensity の apply を省略せずに使うようにしています。

CodensitySample.scala
package fits.sample

import scalaz._
import Scalaz._

object CodensitySample extends App {
    // (1) Codensity[Function0, Int] で apply の結果は Function0[Unit]
    Codensity.pureCodensity(1).apply { (x) => () => println(x) }()

    // (2) Codensity[List, Int] で apply の結果は List[Int]
    Codensity.pureCodensity(2).apply { (x) => List(x) } |> println

    // (3) Codensity[Option, Int] で apply の結果は Option[Int]
    Codensity.pureCodensity(3).apply { Option(_) } |> println

    // (4) rep を使って List[Int] から Codensity[List, Int] を作成
    Codensity.rep(List(1, 2)).apply { (x) => List(x, x * 10, x * 100) } |> println

    /* (5) バインド >>= を使うには improve を使う
     *   'Codensity.pureCodensity(5) >>= ・・・' とするとコンパイルエラー
     */
    (Codensity.pureCodensity(5).improve >>= { (x) => Codensity.pureCodensity[Option, Int](x + 3) }) apply { (x) => Option(x * 10) } foreach(println)
}

なお、pureCodensity を使う際にコンテナの型 (型パラメータ F) が自明でなければ (5) の "Codensity.pureCodensity[Option, Int](x + 3)" のように型を明示します。

実行結果
> sbt console
・・・
scala> fits.sample.CodensitySample.main(null)
1
List(2)
Some(3)
List(1, 10, 100, 2, 20, 200)
80

flatMap の処理

前回ののバインド処理サンプルと同様のものを Codensity で実装してみました。
ここではバインド >>= の代わりに flatMap で処理を繋げ、apply には値を Option に格納する関数を渡しています。

CodensitySample2.scala
・・・
object CodensitySample2 extends App {

    def cont[F[+_]](a: Int) = Codensity.pureCodensity[F, Int](a)

    def calc1[F[+_]](x: Int) = cont[F](x + 3)

    def calc2[F[+_]](x: Int) = cont[F](x * 10)

    def calc3[F[+_]](x: Int) = cont[F](x + 4)

    def calcAll[F[+_]](x: Int) = cont[F](x).flatMap(calc1).flatMap(calc2).flatMap(calc3)

    // a. 2 + 3 = 5
    calc1(2).apply { Option(_) } foreach(println)

    // b. ((2 + 3) * 10) + 4 = 54
    calcAll(2).apply { Option(_) } foreach(println) 

    // c. 54 - 9 = 45
    calcAll(2).apply { (x) => Option(x - 9) } foreach(println)
}
実行結果
scala> fits.sample.CodensitySample2.main(null)
5
54
45

callCC の実装

実用性はともかく、次は callCC を Codensity で実装してみました。

継続モナドにおける callCC の肝は以下の処理ですが。

  • 入れ子になった継続モナドにおいて、自分に渡された継続(関数)を無視して親の継続を呼び出す

Scalaz の Codensity では apply メソッドを実装しなければならない関係上、本来無視するはずの関数の戻り値の型に依存してしまい工夫が必要となります。

Codensity トレイトの apply メソッド
def apply[B](f: A => F[B]): F[B]

例えば、以下のように実装すると (1) の型パラメータ C と (2) の型パラメータ C は別物なのでコンパイル時に type mismatch エラーが発生します。

コンパイルエラー(type mismatch)が発生する callCC の実装例
def callCC[F[+_], A, B](f: (A => Codensity[F, B]) => Codensity[F, A]): Codensity[F, A] = {
    new Codensity[F, A] { 
        // (1)
        def apply[C](k: A => F[C]) = {
            f { a: A =>
                new Codensity[F, B] {
                    // (2) ここでの C は (1) の C とは別の型
                    override def apply[C](f: B => F[C]) = {
                        // この結果の型は (1) の C で
                        // (2) の C とは型が異なり type mismatch となる
                        k(a)
                    }
                }
            }.apply(k)
        }
    }
}

また、(2) で override def apply(f: B => F[C]) のように型パラメータを省略する事もできません。 *2


試行錯誤してみましたが、この問題に対する良い解決策を思いつかなかったので、とりあえず下記 (1) のように asInstanceOf でキャストして回避しました。

CodensityFunc.scala (callCC の実装)
・・・
object CodensityFunc {
    def callCC[F[+_], A, B](f: (A => Codensity[F, B]) => Codensity[F, A]): Codensity[F, A] = {
        new Codensity[F, A] { 
            def apply[C](k: A => F[C]) = {
                f { a: A =>
                    new Codensity[F, B] {
                        override def apply[D](f: B => F[D]) = {
                            // (1)
                            k(a).asInstanceOf[F[D]]
                        }
                    }
                }.apply(k)
            }
        }
    }
}

なお、以前の Codensity トレイトには sealed が付いていたので、このように apply メソッドを自前で実装する事はできなかったのですが、最近のバージョンでは sealed が外れて実装できるようになっています。

callCC の処理1

それでは、callCC を使った単純なサンプルを実装してみます。

CallCCSample.scala
・・・
object CallCCSample extends App {

    def sample[F[+_]](n: Int): Codensity[F, Int] = CodensityFunc.callCC { cc1: (Int => Codensity[F, Int]) =>
        if (n % 2 == 1) {
            cc1(n) // (1)
        }
        else {
            Codensity.pureCodensity(n * 10) // (2)
        }
    }

    sample(1).apply { Option(_) } foreach(println)
    sample(2).apply { Option(_) } foreach(println)
    sample(3).apply { Option(_) } foreach(println)
    sample(4).apply { Option(_) } foreach(println)
}

sample の処理内容は以下のようになっており、apply には値を Option に格納する関数を渡しています。

  • 引数 n が奇数なら n の値を適用する Codensity を返す (1)
  • 引数 n が偶数なら n * 10 の値を適用する Codensity を返す (2)

実行結果は以下の通りです。
奇数ならそのままの値、偶数なら 10 倍した値が出力されます。

実行結果
scala> fits.sample.CallCCSample.main(null)
1
20
3
40

callCC の処理2

最後に callCC をネストさせたサンプルです。

CallCCSample2.scala
・・・
object CallCCSample2 extends App {

    def sample[F[+_]](n: Int): Codensity[F, Int] = CodensityFunc.callCC { cc1: (Int => Codensity[F, Int]) =>
        if (n % 2 == 1) {
            cc1(n) // (1)
        }
        else {
            for {
                x <- CodensityFunc.callCC { cc2: (Int => Codensity[F, Int]) =>
                    n match {
                        case x if (x < 4) => cc2(n * 1000) // (2)
                        case 4 => cc1(n * 100) // (3)
                        case _ => Codensity.pureCodensity[F, Int](n * 10) // (4)
                    }
                }
            } yield (x + 1) // (5)
        }
    }

    sample(1).apply { Option(_) } foreach(println) // (1)
    sample(2).apply { Option(_) } foreach(println) // (2) (5)
    sample(3).apply { Option(_) } foreach(println) // (1)
    sample(4).apply { Option(_) } foreach(println) // (3)
    sample(5).apply { Option(_) } foreach(println) // (1)
    sample(6).apply { Option(_) } foreach(println) // (4) (5)
}

sample の処理内容は以下のようになります。

  • 引数 n が奇数なら n の値を適用する Codensity を返す (1)
  • 引数 n が偶数の場合
    • 4 より小さいと 1000 倍した値に +1 した値を適用する Codensity を返す (2) (5)
    • 4 なら 100 倍した値を適用する Codensity を返す (3)
    • それ以外は 10 倍した値に +1 した値を適用する Codensity を返す (4) (5)

(3) のように 2つ目の callCC 内で cc1 を呼び出すと (5) は実行されず、(2) のように cc2 を呼び出した場合は (5) が適用される事になります。

実行結果
scala> fits.sample.CallCCSample2.main(null)
1
2001
3
400
5
61

*1:"() => println(x)" の部分が Function0[Unit] に該当

*2:method apply overrides nothing エラーとなる

Scalaz で継続モナド

以前(id:fits:20121104)、Haskell で実装した継続モナドのサンプルを Scalaz で実装してみました。

なお、今のところ Scalaz に継続モナドは用意されていないようで、id:fits:20121111 のような方法で自作する必要がありました。

ただし、実際のところ Scala で継続モナドが必要となるケースは基本的に無さそうな気がします。


サンプルソースは http://github.com/fits/try_samples/tree/master/blog/20121125/


今回使用した sbt 用のビルドファイルは以下です。

build.sbt
scalaVersion := "2.10.0-RC2"

libraryDependencies += "org.scalaz" % "scalaz-core" % "7.0.0-M4" cross CrossVersion.full

継続モナドの実装

はじめに、継続モナドを実装します。
Haskell の実装を参考に Cont モナドと callCC を定義してみました。

Cont.scala (継続モナドの定義)
package fits.sample

import scalaz._
import Scalaz._

// モナドとして扱う型の定義
case class Cont[R, A](runCont: (A => R) => R)
// 継続モナドの注入関数・連鎖関数を実装
trait ContMonad[R] extends Monad[({type r[a] = Cont[R, a]})#r] {
    // 注入関数の実装
    def point[A](a: => A) = Cont { k => k(a) }
    // 連鎖関数の実装
    def bind[A, B](fa: Cont[R, A])(f: (A) => Cont[R, B]) = {
        Cont { k =>
            fa.runCont { a =>
                f(a).runCont(k)
            }
        }
    }
}

trait ContFunctions {
    // callCC の実装
    def callCC[R, A, B](f: (A => Cont[R, B]) => Cont[R, A]): Cont[R, A] = {
        Cont { k =>
            f { a =>
                Cont { _ => k(a) }
            }.runCont(k)
        }
    }
}

trait ContInstances {
    // 継続モナドのインスタンス定義
    implicit def contInstance[R] = new ContMonad[R] {
    }
}

case object Cont extends ContFunctions with ContInstances

バインド >>= の処理

id:fits:20121104 と同様にバインド関数 >>= を使った簡単なサンプルを書いてみました。

Sample.scala (バインド処理のサンプル)
package fits.sample

import scalaz._
import Scalaz._

object Sample extends App {
    import Cont._
    // 継続モナドの作成
    def cont[R](a: Int) = contInstance[R].point(a)

    def calc1[R](x: Int) = cont[R](x + 3)

    def calc2[R](x: Int) = cont[R](x * 10)

    def calc3[R](x: Int) = cont[R](x + 4)

    def calcAll[R](x: Int) = cont[R](x) >>= calc1 >>= calc2 >>= calc3

    calc1(2).runCont { println } // a. 2 + 3 = 5

    calcAll(2).runCont { println } // b. ((2 + 3) * 10) + 4 = 54

    calcAll(2).runCont { x => x - 9 } |> println // c. 54 - 9 = 45
}

a. は calc1(2) で得た継続モナドから runCont で取り出した値 (継続渡し形式の処理) に継続 (println 関数) を渡しており、x(=2) + 3 の結果を引数として println が実行される事になります。

b. は calcAll(2) で得た継続モナドから取り出した値に println を渡しており、以下のような処理が実施されます。

  1. 2 を引数に calc1 実行
  2. calc1 の結果を引数に calc2 実行
  3. calc2 の結果を引数に calc3 実行
  4. calc3 の結果を引数に println 実行

>>= で処理を繋げる事で、処理結果を次の処理に渡していき最終的に継続 (a. や b. における println) を呼び出すような処理を実装できます。

c. は println の代わりに x - 9 という処理を継続として渡しており、これによって継続渡し形式の処理結果が 54 - 9 = 45 となります。

実行結果
> sbt console
・・・
scala> fits.sample.Sample.main(null)
5
54
45

callCC の処理1 (簡易版)

callCC を使った単純なサンプルを実装します。

CallCCSample1.scala (callCC の簡易版サンプル1)
package fits.sample

import scalaz._
import Scalaz._

object CallCCSample1 extends App {
    import Cont._

    def sample[R](n: Int): Cont[R, Int] = callCC { cc: (Int => Cont[R, Int]) =>
        if(n % 2 == 1) {
            cc(n) // (1)
        }
        else {
            contInstance[R].point(n * 10) // (2)
        }
    }

    sample(1).runCont { println } // (1)
    sample(2).runCont { println } // (2)
    sample(3).runCont { println } // (1)
    sample(4).runCont { println } // (2)
}

sample の処理内容は以下のようになっています。

  • 引数 n が奇数なら n の値を継続に適用する継続モナドを返す (1)
  • 引数 n が偶数なら n * 10 の値を継続に適用する継続モナドを返す (2)

実行結果は以下の通りです。
奇数ならそのままの値、偶数なら 10 倍した値が出力されます。

実行結果
scala> fits.sample.CallCCSample1.main(null)
1
20
3
40

callCC の処理1a (Haskell のサンプルに近づけた版)

実は、上記 callCC のサンプルは id:fits:20121104 の Haskell 版と実装方法が結構違っていましたので、when 等も定義して近づけてみました。(かなり分かり難くなってしまいましたが)

CallCCSample1a.scala (callCC のHaskell近似版サンプル1)
package fits.sample

import scalaz._
import Scalaz._

object CallCCSample1a extends App {
    import Cont._

    val odd = (n: Int) => n % 2 == 1

    def when[M[_], A](cond: Boolean)(f: => M[A])(implicit M: Pointed[M]) = 
        if (cond) f else M.point(())

    def sample[R](n: Int): Cont[R, Int] = callCC { cc: (Int => Cont[R, Int]) =>
        for {
            _ <- when (odd(n)) {
                for {
                    _ <- cc(n) // (1)
                } yield ()
            }
        } yield (n * 10) // (2)
    }

    sample(1).runCont { println } // (1)
    sample(2).runCont { println } // (2)
    sample(3).runCont { println } // (1)
    sample(4).runCont { println } // (2)
}

なお、こちらのサンプルをコンパイルする際には -feature オプションを指定します。(指定しないと warning が出ます)

実行結果
> sbt compile -feature
・・・
> sbt console
・・・
scala> fits.sample.CallCCSample1a.main(null)
1
20
3
40

callCC の処理2 (簡易版)

次は、callCC をネストさせたサンプルです。

CallCCSample2.scala (callCC のHaskell簡易版サンプル2)
package fits.sample

import scalaz._
import Scalaz._

object CallCCSample2 extends App {
    import Cont._

    def sample[R](n: Int): Cont[R, Int] = callCC { cc1: (Int => Cont[R, Int]) =>
        if(n % 2 == 1) {
            cc1(n) // (1)
        }
        else {
            for {
                x <- callCC { cc2: (Int => Cont[R, Int]) =>
                    n match {
                        case x if (x < 4) => cc2(n * 1000) // (2)
                        case 4 => cc1(n * 100) // (3)
                        case _ => contInstance[R].point(n * 10) // (4)
                    }
                }
            } yield (x + 1) // (5)
        }
    }

    sample(1).runCont { println } // (1)
    sample(2).runCont { println } // (2) (5)
    sample(3).runCont { println } // (1)
    sample(4).runCont { println } // (3)
    sample(5).runCont { println } // (1)
    sample(6).runCont { println } // (4) (5)
}

sample の処理内容は以下のようになります。

  • 引数 n が奇数なら n の値を継続に適用する継続モナドを返す (1)
  • 引数 n が偶数の場合
    • 4 より小さいと 1000 倍した値に +1 した値を継続に適用する継続モナドを返す (2) (5)
    • 4 なら 100 倍した値を継続に適用する継続モナドを返す (3)
    • それ以外は 10 倍した値に +1 した値を継続に適用する継続モナドを返す (4) (5)

(3) のように 2つ目の callCC 内で cc1 を呼び出すと (5) は実行されず、(2) のように cc2 を呼び出した場合は (5) が適用される事になります。

実行結果
scala> fits.sample.CallCCSample2.main(null)
1
2001
3
400
5
61

callCC の処理2a (Haskell のサンプルに近づけた版)

こちらも when 等を定義して Haskell のサンプルに近づけてみました。

CallCCSample2a.scala (callCC のHaskell近似版サンプル2)
package fits.sample

import scalaz._
import Scalaz._

object CallCCSample2a extends App {
    import Cont._

    val odd = (n: Int) => n % 2 == 1

    def when[M[_], A](cond: Boolean)(f: => M[A])(implicit M: Pointed[M]) = 
        if (cond) f else M.point(())

    def sample[R](n: Int): Cont[R, Int] = callCC { cc1: (Int => Cont[R, Int]) =>
        for {
            _ <- when (odd(n)) {
                for {
                    _ <- cc1(n) // (1)
                } yield ()
            }
            x <- callCC { cc2: (Int => Cont[R, Int]) =>
                for {
                    _ <- when (n < 4) {
                        for {
                            _ <- cc2(n * 1000) // (2)
                        } yield ()
                    }
                    _ <- when (n == 4) {
                        for {
                            _ <- cc1(n * 100) // (3)
                        } yield ()
                    }
                } yield (n * 10) // (4)
            }
        } yield (x + 1) // (5)
    }

    sample(1).runCont { println } // (1)
    sample(2).runCont { println } // (2) (5)
    sample(3).runCont { println } // (1)
    sample(4).runCont { println } // (3)
    sample(5).runCont { println } // (1)
    sample(6).runCont { println } // (4) (5)
}
実行結果
> sbt compile -feature
・・・
> sbt console
・・・
scala> fits.sample.CallCCSample2a.main(null)
1
2001
3
400
5
61

Haskell と Scalaz でモナドを自作

今回は、Haskell と Scalaz でモナドを自作してみました。

良い題材を思いつかなかったので、とりあえず以下のような単純なモナド(Counter モナドとする)を自作する事にしました。

  • カウンターを持たせて、バインドで処理を繋ぐ度にカウンター同士を加算するモナド *1

Haskell・Scalaz のどちらも、概ね以下のようにしてモナドを作成します。

なお、Monadインスタンスを定義する際、以下の関数(もしくはメソッド)を実装する事になります。

種類 Haskell Scalaz
注入関数 return point
連鎖関数 >>= bind

サンプルソースは http://github.com/fits/try_samples/tree/master/blog/20121111/


ちなみに、このブログの最初のサンプルはモナド則を満たしていなかった *3 ので修正しました。

Haskell の場合

それでは、Haskell で Counter モナドを作成してみます。

まず、モナドとする型 Counter を定義します。任意の型の値と Int 型のカウンターをタプルとしてフィールドに持つ型を newtype で定義し、getCount 関数でタプルの内容を取得できるようにしています。(1)

次に、Counter を Monadインスタンスとして定義し、return と >>= 関数を以下のように実装しています。(2)

  • 注入関数 return は引数 x の値とカウンター値が 0 のタプルを持つ Counter モナドを返す (a)
  • 連鎖関数 >>= は元の Counter モナドが持つ値 x にモナディック関数 f を適用した結果のモナドから取り出した値 y とカウンター d に元の Counter モナドが持つカウンター c を加算したタプルを持つ Counter モナドを返す (b)

最後に、Counter モナドの動作を確認するため、モナディック関数 append を定義し main で return や >>= を試しています。

append は Counter モナドの値 x に指定の文字列 s を連結しカウンターが 1 の Counter モナドを返します。

counter.hs (Haskell版 Counter モナド
-- (1) モナドとして扱う型を定義
newtype Counter a = Counter { getCount :: (a, Int) }

-- (2) Monad のインスタンスを定義
instance Monad Counter where
    -- (a) 注入関数の実装
    return x = Counter (x, 0)
    -- (b) 連鎖関数の実装
    (Counter (x, c)) >>= f = let (y, d) = getCount(f x) in Counter (y, c + d)

-- モナディック関数
append :: String -> String -> Counter String
append s x = Counter (x ++ s, 1)

-- Counter モナドの利用
main = do
    -- ("a", 0)
    print $ getCount $ return "a"

    -- ("ab", 1) 左恒等性
    print $ getCount $ return "a" >>= append "b"
    print $ getCount $ append "b" "a"

    -- ("abc", 2)
    print $ getCount $ return "a" >>= append "b" >>= append "c"

    -- ("d", 3) 右恒等性
    print $ getCount $ Counter ("d", 3) >>= return

実行結果は以下の通り。>>= で append を繋ぐ度にカウンターが増えている事を確認できます。

実行結果
> runghc counter.hs
("a",0)
("ab",1)
("ab",1)
("abc",2)
("d",3)

Scalaz の場合

今度は、Scalaz で Counter モナドを作成してみます。

まず、モナドとする型 Counter を定義します。任意の値とカウンターのタプルを持つ case class を定義し、count でタプルの内容を取得できるようにしています。(1)

次に、以下のようにして Counter を Monadインスタンスとしています。(2)

  • CounterInstances トレイトを定義
  • CounterInstances トレイト内に counterInstance を定義し Monad トレイトの実装を設定
  • CounterInstances トレイトを extends するコンパニオンオブジェクトを定義
CounterSample.scala (Scalaz版 Counter モナド
package fits.sample

import scalaz._
import Scalaz._

// (1) モナドとして扱う型を定義
case class Counter[A](count: (A, Int))

// (2) Monad のインスタンスを定義
trait CounterInstances {
    implicit val counterInstance = new Monad[Counter] {
        // (a) 注入関数の実装
        def point[A](x: => A): Counter[A] = Counter (x, 0)
        /**
         * (b) 連鎖関数の実装
         *
         * b1. Counter モナド fa からタプルの内容を取得
         * b2. x の値に f を適用した結果の Counter モナドからタプルの内容を取得
         * b3. y の値とカウンター値 d に fa のカウンター値 c を加算した値を持つ Counter モナドを返す
         */
        def bind[A, B](fa: Counter[A])(f: (A) => Counter[B]): Counter[B] = {
            val (x, c) = fa.count // b1.
            val (y, d) = f(x).count // b2.
            Counter (y, c + d) // b3.
        }
    }
}
// (2) Monad のインスタンスを定義
case object Counter extends CounterInstances

// Counter モナドの利用
object CounterSample extends App {
    import Counter.counterInstance.point

    // モナディック関数
    val append = (s: String) => (x: String) => Counter (x + s, 1)

    // ("a", 0)
    point("a").count |> println

    // ("ab", 1) 左恒等性
    ( point("a") >>= append("b") ).count |> println
    ( append("b")("a") ).count |> println

    // ("abc", 2)
    ( point("a") >>= append("b") >>= append("c") ).count |> println

    // (d, 3) 右恒等性
    ( Counter ("d", 3) >>= { s => point(s) } ).count |> println
}

sbt 用ビルドファイルの内容は以下の通りです。

build.sbt
scalaVersion := "2.10.0"

libraryDependencies += "org.scalaz" %% "scalaz-core" % "7.0.0-M7"

mainClass in (Compile, run) := Some("fits.sample.CounterSample")

sbt による実行結果は以下の通りです。

実行結果
> sbt run
・・・
[info] Running fits.sample.CounterSample
(a,0)
(ab,1)
(ab,1)
(abc,2)
(d,3)

*1:通常、このような用途には Writer モナドを使います

*2:HaskellMonad 型クラス、Scalaz は Monad トレイト

*3:つまり、モナドでは無かったという事です

Scalaz で Reader モナドと Applicative

今回は関数をモナドとして扱う Reader モナドを Scalaz で使ってみます。

  • Scalaz 7.0.0-M3

サンプルソースは http://github.com/fits/try_samples/tree/master/blog/20121013/

sbt 用ビルドファイルは以下の通りです。

build.sbt
scalaVersion := "2.10.0-M7"

libraryDependencies += "org.scalaz" % "scalaz-core" % "7.0.0-M3" cross CrossVersion.full

Haskell の場合

まずは、Reader モナドを使った Haskell 版のサンプルです。

reader_sample.hs (Reader モナド
import Control.Monad.Instances

f1 :: Int -> Int
f1 = do
    a <- (*2)
    b <- (+10)
    return (a + b)

f2 :: Int -> Int
f2 = do
    a <- (*2)
    b <- (+10)
    c <- (+5)
    return (a + b + c)

main = do
    putStrLn $ show $ f1 4
    putStrLn $ show $ f2 4

f1 関数は引数を 1つ取り、* 2 を適用した結果を a 、+ 10 を適用した結果を b として a + b の結果を返します。
つまり、引数を x とすると以下のような計算が実施される事になります。

  • f1 関数は (2 * x) + (10 + x)
  • f2 関数は (2 * x) + (10 + x) + (5 + x)

実行結果は以下のように、f1 4 の結果が (2 * 4) + (10 + 4) = 22 、f2 4 の結果が (2 * 4) + (10 + 4) + (5 + 4) = 31 となります。

実行結果
> runghc reader_sample.hs
22
31

上記と同等の処理を Applicative で実装すると以下のようになります。

applicative_sample.hs (Applicative)
import Control.Applicative

main = do
    let f1 = (+) <$> (*2) <*> (+10)
    putStrLn $ show $ f1 4

    let f2 = (\a b c -> a + b + c) <$> (*2) <*> (+10) <*> (+5)
    putStrLn $ show $ f2 4
実行結果
> runghc applicative_sample.hs
22
31

Scalaz の場合

それでは Scalaz を使って実装してみます。

Reader モナドの場合、do が for になる以外はほぼ Haskell と同じように実装できます。

ReaderSample.scala (Reader モナド
package fits.sample

import scalaz._
import Scalaz._

object ReaderSample extends App {
    // (2 * x) + (10 + x)
    val f1 = for {
        a <- 2 * (_: Int)
        b <- 10 + (_: Int)
    } yield a + b

    println(f1(4))

    // (2 * x) + (10 + x) + (5 + x)
    val f2 = for {
        a <- 2 * (_: Int)
        b <- 10 + (_: Int)
        c <- 5 + (_: Int)
    } yield a + b + c

    println(f2(4))
}

実行結果は以下の通りです。

実行結果
scala> fits.sample.ReaderSample.main(null)
22
31


次に、Applicative での実装は以下のようになりました。

一応、Haskell の実装に近づけるよう試行錯誤してみましたが、こちらは上手くいきませんでした。(他によい方法があるかもしれませんが)

@ を使う方法をご紹介していただきましたので追加しました。こちらの方法はタプルをパターンマッチさせる必要も無く Haskell の実装に近づきました。


なお、multiply(2) <*> plus(10) 等の結果は以下のようなタプルとなるのでパターンマッチを使って処理しています。

  • multiply(2) <*> plus(10) の結果 *1 は (2 * x, 10 + x)
  • multiply(2) <*> plus(10) <*> plus(5) の結果 *2 は ( (2 * x, 10 + x), 9 + x)

ちなみに >>> は ComposeOps のメソッドで関数合成を行います。

ApplicativeSample.scala (Applicative)
package fits.sample

import scalaz._
import Scalaz._

object ApplicativeSample extends App {
    val multiply = (x: Int) => (y: Int) => x * y
    val plus = (x: Int) => (y: Int) => x + y

    val f1 = multiply(2) <*> plus(10) >>> { case (a, b) => a + b }
    println(f1(4))
    // 以下でも可
    val f1a = ^( multiply(2) <*> plus(10) ) { case (a, b) => a + b }
    println(f1a(4))
    // 以下でも可
    val f1b = ( multiply(2) |@| plus(10) ) { _ + _ }
    println(f1b(4))

    val f2 = multiply(2) <*> plus(10) <*> plus(5) >>> { case ((a, b), c) => a + b + c }
    println(f2(4))
    // 以下でも可
    val f2a = ^( multiply(2) <*> plus(10) <*> plus(5) ) { case ((a, b), c) => a + b + c }
    println(f2a(4))
    // 以下でも可
    val f2b = ( multiply(2) |@| plus(10) |@| plus(5) ) { _ + _ + _ }
    println(f2b(4))
}
実行結果
scala> fits.sample.ApplicativeSample.main(null)
22
22
22
31
31
31

最後に、ArrowOps の &&& メソッドを使って以下のように実装する事も可能です。

ArrowSample.scala (Arrow)
package fits.sample

import scalaz._
import Scalaz._

object ArrowSample extends App {
    val multiply = (x: Int) => (y: Int) => x * y
    val plus = (x: Int) => (y: Int) => x + y

    val f1 = ( multiply(2) &&& plus(10) ) >>> { case (a, b) => a + b }
    println(f1(4))

    val f2 = ( multiply(2) &&& plus(10) &&& plus(5) ) >>> { case ((a, b), c) => a + b + c }
    println(f2(4))
}
実行結果
scala> fits.sample.ArrowSample.main(null)
22
31

*1:引数が 4 の場合は (8, 14)

*2:引数が 4 の場合は ((8, 14), 9)

Scalaz で Writer モナド

今回は、ログを追記する Writer モナドを Scalaz で使ってみます。

  • Scalaz 7.0.0-M3
  • sbt 0.12.0

サンプルソースは http://github.com/fits/try_samples/tree/master/blog/20120917/


使用した sbt 用ビルドファイルは以下です。

build.sbt
scalaVersion := "2.10.0-M7"

libraryDependencies += "org.scalaz" % "scalaz-core" % "7.0.0-M3" cross CrossVersion.full

単純な Writer モナド

まずは、単純な Writer モナドのサンプルです。

WriterT.writer に (ログ, 値) のタプルを渡して Writer モナドを生成します。

Writer モナドを返す関数(下記の logNum や logNumList)を >>= で繋げばログが追記されていきます。*1

下記サンプルではログ部分に String と List をそれぞれ使った Writer モナドを用意し、String 版では " + <値>" という文字列が、List 版では値そのものがログとして残るようにしています。

なお、ログの内容を取得するには written、値を取得するには value を使います。

WriterSample.scala
package fits.sample

import scalaz._
import Scalaz._
import WriterT._

object WriterSample extends App {
    // ログに String を使った Write モナド生成( Writer[String, Int] )
    val logNum = (n: Int) => (x: Int) => writer (s" + $n", n + x)

    val r1 = writer ("2", 2) >>= logNum(5) >>= logNum(3)

    println(s"${r1.written} = ${r1.value}")

    // >>= の代わりに for を使用
    val r2 = for {
        w1 <- writer ("2", 2)
        w2 <- logNum(5)(w1)
        w3 <- logNum(3)(w2)
    } yield w3

    println(s"${r2.written} = ${r2.value}")

    // ログに List を使った Writer モナド生成( Writer[List[Int], Int] )
    val logNumList = (n: Int) => (x: Int) => writer (List(n), n + x)

    val r3 = writer (List(2), 2) >>= logNumList(5) >>= logNumList(3)

    println(s"${r3.written} = ${r3.value}")
}

実行結果は以下の通り。
加算した値がログとして残っている事を確認できます。

実行結果
> sbt console
・・・
scala> fits.sample.WriterSample.main(null)
2 + 5 + 3 = 10
2 + 5 + 3 = 10
List(2, 5, 3) = 10

List モナドの機能を備えた Writer モナド (WriterT.writerT() の利用)

次に、List モナドの機能を備えた Writer モナドを使ってみます。

基本的に、WriterT.writerT() にモナドで包んだ (ログ, 値) のタプルを渡す事で、別のモナドの機能を備えた Writer モナドを取得できます。

下記サンプルでは、List モナドに包んだ (String, Int) を WriterT.writerT() に渡す事で WriterT[List, String, Int] *2 を取得しています。

ちなみに、Scalaz における Writer[A, B] 型は WriterT[scalaz.Id.Id, A, B] の別名です。

WriterTSample.scala
・・・
object WriterTSample extends App {
    // Writer モナド生成( WriterT[List, String, Int] )
    val logManyNum = (n: Int) => (x: Int) => {
        val list = for {
            i <- (1 to n).toList
        } yield (s" + $i", x + i)

        // (String, Int) タプルの List を使って Writer モナド生成
        writerT(list)
    }

    val w = writerT(("2", 2) :: Nil) >>= logManyNum(3) >>= logManyNum(2)
    //以下でも同じ
    //val w = writerT(List(("2", 2))) >>= logManyNum(3) >>= logManyNum(2)

    println(s"written = ${w.written}")
    println(s"value = ${w.value}")
    println(s"run = ${w.run}")
}

実行結果は以下の通り。
ログと値がそれぞれ List になっており、run によって (ログ, 値) タプルの List を取得しています。

実行結果
scala> fits.sample.WriterTSample.main(null)
written = List(2 + 1 + 1, 2 + 1 + 2, 2 + 2 + 1, 2 + 2 + 2, 2 + 3 + 1, 2 + 3 + 2)
value = List(4, 5, 5, 6, 6, 7)
run = List((2 + 1 + 1,4), (2 + 1 + 2,5), (2 + 2 + 1,5), (2 + 2 + 2,6), (2 + 3 + 1,6), (2 + 3 + 2,7))

ナイト移動の経路1

それでは Writer モナドの応用として、前回 id:fits:20120912 のナイト移動の処理に対して移動経路をログとして付けてみます。

まずは List モナドの要素を Writer モナドとする事で実装してみました。

moveKnight の引数を Writer モナドに変更し Writer モナドの List を返すように変更しています。 (ログは String で追記)

そして、start から x 手後に end に到達した際の経路を返す routeReachIn を追加しました。

MoveKnightWriter.scala
・・・
object MoveKnightWriter extends App {

    type KnightPos = Tuple2[Int, Int]
    type PosCalc = Function2[Int, Int, Int]

    // Writer モナドの生成
    val createWriter = (p: KnightPos, sep: String) => writer (s"$sep$p", p)

    // 次の位置を設定した Writer モナドを取得
    val nextPos = (a: Int, b: Int, fa: PosCalc, fb: PosCalc) => 
        (p: KnightPos) => createWriter((fa(p._1, a), fb(p._2, b)), " -> ")

    val fl = List((_: Int) + (_: Int), (_: Int) - (_: Int))

    val moveKnight = (p: Writer[String, KnightPos]) => 
        (
            for {
                a <- List(2, 1)
                b <- List(2, 1)
                fa <- fl
                fb <- fl
                if a != b
            } yield p >>= nextPos(a, b, fa, fb)
        ) filter {
            _.value match {
                case (x, y) => 1 <= x && x <= 8 && 1 <= y && y <= 8
            }
        }

    val inMany = (x: Int) => (start: KnightPos) => {
        List(createWriter(start, "")) >>= List.fill(x){ Kleisli(moveKnight) }.reduceRight {(a, b) =>
            b <=< a
        }
    }

    // start から x 手後に end へ到達した際の経路 (String の List) を取得
    val routeReachIn = (x: Int) => (start: KnightPos, end: KnightPos) =>
        inMany(x)(start).filter { _.value == end } map { _.written }

    routeReachIn(3)((6, 2), (6, 1)).foreach {println}
    println("-----")
    routeReachIn(3)((6, 2), (7, 3)).foreach {println}
}

実行結果は以下の通り。
3手で (6, 2) から (6, 1) へ移動した際の経路が出力できており、(7, 3) への経路は無いため出力されていません。

実行結果
scala> fits.sample.MoveKnightWriter.main(null)
(6,2) -> (8,1) -> (7,3) -> (6,1)
(6,2) -> (4,1) -> (5,3) -> (6,1)
(6,2) -> (7,4) -> (5,3) -> (6,1)
(6,2) -> (7,4) -> (8,2) -> (6,1)
(6,2) -> (5,4) -> (7,3) -> (6,1)
(6,2) -> (5,4) -> (4,2) -> (6,1)
-----

なお、moveKnight は以下のように 2段で for を使って実装することも可能です。

val moveKnight = (p: Writer[String, KnightPos]) => 
    (
        for {
            a <- List(2, 1)
            b <- List(2, 1)
            fa <- fl
            fb <- fl
            if a != b
        } yield {
            for {
                pv <- p
                np <- nextPos(a, b, fa, fb)(pv)
            } yield np
        }
    ) filter {
        ・・・
    }

ナイト移動の経路2

次は WriterT.writerT() を使って List モナドの機能を持つ Writer モナドを使ってみます。

moveKnight の結果を WriterT[List, String, KnightPos] 用に変換し、Writer モナドを取得する moveKnightWriter 関数を別途用意してみました。

また、moveKnightWriter 関数を Kleisli に上手く適用する方法が分からなかったので *3、関数合成は >>= を使って自前で行っています。

MoveKnightWriterT.scala
・・・
object MoveKnightWriterT extends App {

    type KnightPos = Tuple2[Int, Int]

    val moveKnight = (p: KnightPos) => List(
        (p._1 + 2, p._2 - 1), (p._1 + 2, p._2 + 1),
        (p._1 - 2, p._2 - 1), (p._1 - 2, p._2 + 1),
        (p._1 + 1, p._2 - 2), (p._1 + 1, p._2 + 2),
        (p._1 - 1, p._2 - 2), (p._1 - 1, p._2 + 2)
    ).filter { case (x, y) => 1 <= x && x <= 8 && 1 <= y && y <= 8 }

    // Writer モナドを生成( WriterT[List, String, KnightPos] )
    val moveKnightWriter = (p: KnightPos) => {
        // List[KnightPos] を List[Tupble2[String, KnightPos]] に変換
        val list = moveKnight(p).map {np =>
            (s" -> $np", np)
        }
        writerT(list)
    }

    val inMany = (x: Int) => (start: KnightPos) => {
        val stWriter = writerT((s"$start", start) :: Nil)
        // 以下でも同じ
        //val stWriter = writerT(List((s"$start", start)))

        stWriter >>= List.fill(x){ moveKnightWriter }.reduceRight {(a, b) =>
            // Kleisli を使わずに関数合成
            (p: KnightPos) => b(p) >>= a
        }
    }

    // start から x 手後に end へ到達した際の経路 (String の List) を取得
    val routeReachIn = (x: Int) => (start: KnightPos, end: KnightPos) =>
        inMany(x)(start).run.filter { _._2 == end } map { _._1 }

    routeReachIn(3)((6, 2), (6, 1)).foreach {println}
    println("-----")
    routeReachIn(3)((6, 2), (7, 3)).foreach {println}
}
実行結果
scala> fits.sample.MoveKnightWriterT.main(null)
(6,2) -> (8,1) -> (7,3) -> (6,1)
(6,2) -> (4,1) -> (5,3) -> (6,1)
(6,2) -> (7,4) -> (5,3) -> (6,1)
(6,2) -> (7,4) -> (8,2) -> (6,1)
(6,2) -> (5,4) -> (7,3) -> (6,1)
(6,2) -> (5,4) -> (4,2) -> (6,1)
-----

*1:ログの追記は Writer モナド内で勝手にやってくれます

*2:ログは String、値は Int

*3:型の関係上、そのままでは適用できないようです

Scalaz でリストモナド - Kleisli による関数合成

前回 id:fits:20120828 に引き続き、今回も書籍「 すごいHaskellたのしく学ぼう! 」 のサンプルを Scalaz で実装してみる事にします。

今回は、リストモナドを使ったナイト移動 *1 の処理です。

  • Scalaz 7.0.0-M3
  • sbt 0.12.0

サンプルソースは http://github.com/fits/try_samples/tree/master/blog/20120912/

3手先の位置

まずはお手本とする Haskell 版です。(本のサンプルそのままです)

Haskell版 move_knight.hs
type KnightPos = (Int, Int)

-- ナイトの次の移動先を列挙
moveKnight :: KnightPos -> [KnightPos]
moveKnight (c, r) = filter onBoard
    [
        (c + 2, r - 1), (c + 2, r + 1),
        (c - 2, r - 1), (c - 2, r + 1),
        (c + 1, r - 2), (c + 1, r + 2),
        (c - 1, r - 2), (c - 1, r + 2)
    ]
    where onBoard (c', r') = c' `elem` [1..8] && r' `elem` [1..8]

-- 3手先の移動位置を列挙(重複あり)
in3 :: KnightPos -> [KnightPos]
in3 start = do
    first <- moveKnight start
    second <- moveKnight first
    moveKnight second
{- 以下でも可
in3 start = return start >>= moveKnight >>= moveKnight >>= moveKnight
-}

-- 指定位置に3手で到達できるか否かを判定
canReachIn3 :: KnightPos -> KnightPos -> Bool
canReachIn3 start end = end `elem` in3 start

main = do
    putStrLn $ show $ moveKnight (8, 1)

    putStrLn $ show $ in3 (6, 2)

    putStrLn $ show $ (6, 2) `canReachIn3` (6, 1)
    putStrLn $ show $ (6, 2) `canReachIn3` (7, 3)

実行結果は以下のようになります。

Haskell版の実行結果
> runghc move_knight.hs
[(6,2),(7,3)]
[(8,1),(8,3),・・・,(3,4),(3,8)]
True
False


それでは、Scala で実装していきます。

まずは、Scalaz を使わずに実装してみます。
do 式の代わりに for を使っている等の違いはありますが、基本的な処理内容は Haskell と同じです。

Scala版 move_knight.scala
type KnightPos = Tuple2[Int, Int]
// ナイトの次の移動先を列挙
val moveKnight = (p: KnightPos) => List(
    (p._1 + 2, p._2 - 1), (p._1 + 2, p._2 + 1),
    (p._1 - 2, p._2 - 1), (p._1 - 2, p._2 + 1),
    (p._1 + 1, p._2 - 2), (p._1 + 1, p._2 + 2),
    (p._1 - 1, p._2 - 2), (p._1 - 1, p._2 + 2)
).filter { case (x, y) => 1 <= x && x <= 8 && 1 <= y && y <= 8 }

// 3手先の移動位置を列挙(重複あり)
val in3 = (start: KnightPos) =>
    for {
        first <- moveKnight(start)
        second <- moveKnight(first)
        third <- moveKnight(second)
    } yield third

// 指定位置に3手で到達できるか否かを判定
val canReachIn3 = (start: KnightPos, end: KnightPos) => in3(start).contains(end)

println( moveKnight (8, 1) )

println( in3 (6, 2) )

println( canReachIn3((6, 2), (6, 1)) )
println( canReachIn3((6, 2), (7, 3)) )

実行すると以下のように Haskell と同等の結果となります。

Scala版の実行結果
> scala move_knight.scala
List((6,2), (7,3))
List((8,1), (8,3), ・・・, (3,4), (3,8))
true
false

ちなみに、moveKnight の処理は for を使って以下のように実装する事も可能です。(ただし、上記のものとは出力結果の順序が異なります)

処理内容は、p の位置と (2, 1) もしくは (1, 2) との加算・減算の組み合わせをリスト化しています。

moveKnight の別実装 Scala版 move_knight2.scala
・・・
val fl = List((_: Int) + (_: Int), (_: Int) - (_: Int))

val moveKnight = (p: KnightPos) =>
    (
        for {
            a <- List(2, 1)
            b <- List(2, 1)
            fa <- fl
            fb <- fl
            if a != b
        } yield (fa(p._1, a), fb(p._2, b))
    ) filter {
        case (x, y) => 1 <= x && x <= 8 && 1 <= y && y <= 8
    }
・・・


次は Scalaz で実装してみます。
と言っても基本的には in3 の処理を >>= を使って書き直しただけです。(ただし、sbt で実行するため object にしています)

Scalaz版 MoveKnight.scala
package fits.sample

import scalaz._
import Scalaz._

object MoveKnight extends App {
    type KnightPos = Tuple2[Int, Int]

    val moveKnight = (p: KnightPos) => List(
        (p._1 + 2, p._2 - 1), (p._1 + 2, p._2 + 1),
        (p._1 - 2, p._2 - 1), (p._1 - 2, p._2 + 1),
        (p._1 + 1, p._2 - 2), (p._1 + 1, p._2 + 2),
        (p._1 - 1, p._2 - 2), (p._1 - 1, p._2 + 2)
    ).filter { case (x, y) => 1 <= x && x <= 8 && 1 <= y && y <= 8 }

    val in3 = (start: KnightPos) => start |> moveKnight >>= moveKnight >>= moveKnight

    val canReachIn3 = (start: KnightPos, end: KnightPos) => in3(start).contains(end)

    println( moveKnight (8, 1) )

    println( in3 (6, 2) )

    println( canReachIn3((6, 2), (6, 1)) )
    println( canReachIn3((6, 2), (7, 3)) )
}

実行結果は以下の通りです。

Scalaz版の実行結果
> sbt console
・・・
scala> fits.sample.MoveKnight.main(null)
List((6,2), (7,3))
List((8,1), (8,3), ・・・, (3,4), (3,8))
true
false

sbt のビルドファイルは以下の通りです。

build.sbt
scalaVersion := "2.10.0-M7"

libraryDependencies += "org.scalaz" % "scalaz-core" % "7.0.0-M3" cross CrossVersion.full

N手先の位置

次は 3手と手数を固定せずに引数で手数を指定できるようにします。

まずは Haskell 版です。(こちらも本のサンプルそのままです)

Haskell版 move_knight_many.hs
import Control.Monad

type KnightPos = (Int, Int)

moveKnight :: KnightPos -> [KnightPos]
moveKnight (c, r) = filter onBoard
    [
        (c + 2, r - 1), (c + 2, r + 1),
        (c - 2, r - 1), (c - 2, r + 1),
        (c + 1, r - 2), (c + 1, r + 2),
        (c - 1, r - 2), (c - 1, r + 2)
    ]
    where onBoard (c', r') = c' `elem` [1..8] && r' `elem` [1..8]

-- x手先の移動位置を列挙
inMany :: Int -> KnightPos -> [KnightPos]
inMany x start = return start >>= foldr (<=<)
    return (replicate x moveKnight)

-- 指定位置にx手で到達できるか否かを判定
canReachIn :: Int -> KnightPos -> KnightPos -> Bool
canReachIn x start end = end `elem` inMany x start

main = do
    putStrLn $ show $ inMany 3 (6, 2)

    putStrLn $ show $ canReachIn 3 (6, 2) (6, 1)
    putStrLn $ show $ canReachIn 3 (6, 2) (7, 3)

moveKnight 関数が x 個入ったリストを作って foldr と <=< でモナディック関数の合成を行っています。

実行結果は以下の通り。3手を指定した場合に 3手固定版と同じ結果となります。

Haskell版の実行結果
> runghc move_knight_many.hs
[(8,1),(8,3),・・・,(3,4),(3,8)]
True
False


Scalaz 版は以下のようになります。
<=< 等を使ったモナディック関数の合成を行うには Kleisli を使います。

Scalaz版 MoveKnightMany.scala
package fits.sample

import scalaz._
import Scalaz._

object MoveKnightMany extends App {
    type KnightPos = Tuple2[Int, Int]

    val moveKnight = (p: KnightPos) => List(
        (p._1 + 2, p._2 - 1), (p._1 + 2, p._2 + 1),
        (p._1 - 2, p._2 - 1), (p._1 - 2, p._2 + 1),
        (p._1 + 1, p._2 - 2), (p._1 + 1, p._2 + 2),
        (p._1 - 1, p._2 - 2), (p._1 - 1, p._2 + 2)
    ).filter { case (x, y) => 1 <= x && x <= 8 && 1 <= y && y <= 8 }

    // x手先の移動位置を列挙
    val inMany = (x: Int) => (start: KnightPos) => {
        start |> List.fill(x){ Kleisli(moveKnight) }.reduceRight {(a, b) =>
            b <=< a
        }
    }

    // 指定位置にx手で到達できるか否かを判定
    val canReachIn = (x: Int) => (start: KnightPos, end: KnightPos) =>
        inMany(x)(start).contains(end)

    println( inMany(3)(6, 2) )

    println( canReachIn(3)((6, 2), (6, 1)) )
    println( canReachIn(3)((6, 2), (7, 3)) )
}

処理内容は Haskell とほぼ同じで、Kleisli でくるんだ moveKnight が x 個入ったリストを作って reduceRight と <=< で関数合成し、合成結果の関数に対して開始位置 start を適用しています。

実行結果は以下の通りです。

Scalaz版の実行結果
> sbt console
・・・
scala> fits.sample.MoveKnightMany.main(null)
List((8,1), (8,3), ・・・, (3,4), (3,8))
true
false
備考

reduceRight を使わずに reduceLeft と >=> を使って以下のようにしても同じ結果となります。(集計結果の方を b で統一しています)

val inMany = (x: Int) => (start: KnightPos) => {
    start |> List.fill(x){ Kleisli(moveKnight) }.reduceLeft {(b, a) =>
        b >=> a
    }
}

*1:チェス盤のナイトの現在位置から次に移動可能な位置を列挙する