2012-11-04

Haskell で継続モナド

Haskell Monad

継続渡し形式（CPS）をモナドとして扱う継続モナドを Haskell で試してみました。
継続モナドは以下のような処理をモナド化します。

何らかの処理結果を引数として継続と呼ばれる関数を呼び出す（継続は外部から与える）

処理結果を引数にコールバック関数が呼ばれるようなイメージで捉えた方が分かり易いかもしれません。

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

>>= の処理

とりあえずバインド関数 >>= を使った簡単なサンプルを書いてみました。

sample.hs

import Control.Monad.Cont

calc1 :: Int -> Cont r Int
calc1 x = return (x + 3)

calc2 :: Int -> Cont r Int
calc2 x = return (x * 10)

calc3 :: Int -> Cont r Int
calc3 x = return (x + 4)

calcAll :: Int -> Cont r Int
calcAll x = return x >>= calc1 >>= calc2 >>= calc3

main = do
    -- a. 2 + 3 = 5
    runCont (calc1 2) print

    -- b. ((2 + 3) * 10) + 4 = 54
    runCont (calcAll 2) print
    -- 上記は以下と同じ
    -- runCont (calcAll 2) (\x -> print x)

    -- c. (((2 + 3) * 10) + 4) - 9 = 45
    print $ runCont (calcAll 2) (\x -> x - 9)

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

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

2 を引数に calc1 実行
calc1 の結果を引数に calc2 実行
calc2 の結果を引数に calc3 実行
calc3 の結果を引数に print 実行

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

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

実行結果

> runghc sample.hs
5
54
45

callCC の処理1

次に callCC 関数を使った簡単なサンプルを書いてみました。

callcc_sample1.hs

import Control.Monad.Cont

sample :: Int -> Cont r Int
sample n = callCC $ \cc -> do
    when (odd n) $ do
        -- (1)
        cc n

    -- (2)
    return (n * 10)

main = do
    runCont (sample 1) print -- (1)
    runCont (sample 2) print -- (2)
    runCont (sample 3) print -- (1)
    runCont (sample 4) print -- (2)

callCC は ((a -> Cont r b) -> Cont r a) を引数にとって Cont r a を返す関数で、上記の callCC に渡しているラムダ式の cc が (a -> Cont r b) に該当します。

cc が呼び出されると callCC 内の残りの処理がスキップされ、cc の引数に渡された値（上記の n）を継続に適用する継続モナドが返ります。

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

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

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

実行結果

> runghc callcc_sample1.hs
1
20
3
40

callCC の処理2

最後に callCC をネストさせたサンプルを書いてみました。

callCC をネストさせる事で、ある程度複雑な制御構造を実現できそうですが、コードが分かり難くなる点に注意が必要だと思います。

callcc_sample2.hs

import Control.Monad.Cont

sample :: Int -> Cont r Int
sample n = callCC $ \cc1 -> do
    when (odd n) $ do
        -- (1)
        cc1 n

    x <- callCC $ \cc2 -> do
        when (n < 4) $ do
            -- (2)
            cc2 (n * 1000)

        when (n == 4) $ do
            -- (3)
            cc1 (n * 100)

        -- (4)
        return (n * 10)

    -- (5)
    return (x + 1)

main = do
    runCont (sample 1) print -- (1)
    runCont (sample 2) print -- (2) (5)
    runCont (sample 3) print -- (1)
    runCont (sample 4) print -- (3)
    runCont (sample 5) print -- (1)
    runCont (sample 6) print -- (4) (5)

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

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

(3) のように 2つ目の callCC 内で cc1 を呼び出すと残処理は全てスキップされる事になりますが、(2) のように cc2 を呼び出した場合は 2つ目の callCC の残処理がスキップされるだけでその後の処理 (5) が適用される事になります。

実行結果

> runghc callcc_sample2.hs
1
2001
3
400
5
61

2012-10-13

Scalaz で Reader モナドと Applicative

Scala Haskell Monad Scalaz

今回は関数をモナドとして扱う 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)

2012-09-12

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

Scala Java Haskell Monad Scalaz

前回 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:チェス盤のナイトの現在位置から次に移動可能な位置を列挙する

2012-08-28

Scalaz で Ordering モノイド

Scala Java Haskell Monad Scalaz

書籍「すごいHaskellたのしく学ぼう! 」の Ordering モノイドを使った lengthCompare 関数を Scalaz で実装してみました。

Scalaz 7.0.0-M3
sbt 0.12.0

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

lengthCompare 関数は以下のように文字列を比較する前に文字列長を比較するというもので、文字列長が等しかった場合のみ（= EQ）文字列の比較（`mappend` の右辺）を実施します。（処理内容は本のままです）

Haskell版 length_compare.hs

import Data.Monoid

lengthCompare :: String -> String -> Ordering
lengthCompare x y = (length x `compare` length y) `mappend` (x `compare` y)

main = do
    putStrLn $ show $ lengthCompare "zen" "ants"
    putStrLn $ show $ lengthCompare "zen" "ant"

実行結果

> runghc length_compare.hs
LT
GT

Scalaz で実装

まず、sbt 用のビルドファイルを作成しておきます。
今回は Scala 2.10.0-M7 と Scalaz Core 7.0.0-M3 を使うように設定しました。

build.sbt

scalaVersion := "2.10.0-M7"

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

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

Scalaz を使った lengthCompare の実装は Haskell と大きな違いは無く、比較の箇所に ?|? を使って |+| （mappend でも可）で繋ぐだけです。

処理的には、OrderOps の ?|? で Ordering を得て、SemigroupOps の |+| で Ordering を Monoid として連結しています。*1

Scalaz版 LengthCompare.scala

import scalaz._
import Scalaz._

object LengthCompare extends App {

    val lengthCompare = (x: String, y: String) => (x.length ?|? y.length) |+| (x ?|? y)
    //以下でも可
    //val lengthCompare = (x: String, y: String) => (x.length ?|? y.length) mappend (x ?|? y)

    println(lengthCompare("zen", "ants"))
    println(lengthCompare("zen", "ant"))
}

sbt run で実行すると Haskell と同様の結果が出力されます。

実行結果

> sbt run
・・・
[info] Running fits.sample.LengthCompare
LT
GT
・・・

なお、?|? の代わりに compare の実行結果を Ordering.fromInt() で Ordering 化する等の実装方法もありますが、?|? を使った方がシンプルだと思います。（ただし、他に良い方法があるかもしれません）

他の実装方法（結果は同じ）

val lengthCompare2 = (x: String, y: String) => Ordering.fromInt(x.length compare y.length) mappend Ordering.fromInt(x compare y)

println(lengthCompare2("zen", "ants"))
println(lengthCompare2("zen", "ant"))

println("-------------")

val lengthCompare3 = (x: String, y: String) => Order[Int].order(x.length, y.length) mappend Order[String].order(x, y)

println(lengthCompare3("zen", "ants"))
println(lengthCompare3("zen", "ant"))

println("-------------")

val lengthCompare4 = (x: String, y: String) => intInstance(x.length, y.length) mappend stringInstance(x, y)

println(lengthCompare4("zen", "ants"))
println(lengthCompare4("zen", "ant"))

*1:最終的に Ordering.orderingInstance の append が実行されます（実装は OrderingInstances トレイトの orderingInstance）

2010-12-26

Haskell, Scala によるパーサーコンビネータを使った CSV ファイルのパース処理

Java Scala Haskell

以前（id:fits:20101129, id:fits:20101204）試したような CSV ファイルのパース処理を書籍 Real World Haskell―実戦で学ぶ関数型言語プログラミングを参考に Haskell と Scala のパーサーコンビネータでやってみました。
Haskell の方は本の内容ほとんどそのままなので簡単に動作しましたが、Scala の方は挙動が良く分からなくて結構苦労しました。

環境は以下の通り。

HaskellPlatform 2010.2.0.0 (GHC 6.10.4)
Scala 2.8.1

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

単純なCSV

まずは、以下のような単純な CSV ファイルをパースするサンプルです。

test_simple.csv

1,test1,10.5
2,"test2",-123,abc

Haskell版は基本的に本の内容そのままです。（出力は手抜きしてます）
sepBy でコンマ区切りの繰り返し、endBy で後ろに改行が付く行の繰り返し、noneOf でコンマと改行以外の文字、many で繰り返しを指定しています。

Haskell版 parse_simple_csv.hs

import Text.ParserCombinators.Parsec

csvFile = endBy line eol
line = sepBy cell (char ',')
cell = many (noneOf ",\n")
eol = char '\n'

main = do
    cs <- getContents
    let res = parse csvFile "" cs

    case res of
        Left err -> print err
        Right x -> putStrLn $ show x

Haskell版実行結果

> runhaskell parse_simple_csv.hs < test_simple.csv
[["1","test1","10.5"],["2","\"test2\"","-123","abc"]]

次に、Scala です。
Scala のパーサコンビネータには、scala.util.parsing.combinator パッケージのトレイト（JavaTokenParsers, RegexParsers 等）を使います。

今回は JavaTokenParsers を使い、Haskell の sepBy の代わりに repsep、 many と noneOf の代わりに正規表現、endBy は rep で実現しました。

注意点として、RegexParsers では文字列（String）を指定した際にデフォルトで空白や改行をスキップするようになっているので、eol の実装に対して以下のような方法を取る必要がありました。（JavaTokenParsers は RegexParsers を extends している）

eol の値に文字（Char）としての改行 '\n' を指定する
skipWhitespace を false にして eol の値に文字列としての改行 "\n" を指定する

これは、文字の場合 Parsers の accept()、文字列の場合 RegexParsers の literal() の暗黙変換が適用される事に起因します。（literal で空白や改行をスキップする処理 handleWhiteSpace を呼ぶ Parser[String] が作成される）

また、行毎の cell の最後の要素に何故か改行が付くので、trim で取り除くようにしました。

Scala版 parse_simple_csv.scala

import scala.io.Source
import scala.util.parsing.combinator._

object SimpleCsv extends JavaTokenParsers {
    def csvFile = rep(line <~ eol)
    def line = repsep(cell, ',')
    //最後のセル要素に改行が含まれるので trim で取り除く
    def cell = """[^,\n]*""".r ^^ (_.trim)
    //'\n' は Char（= Elem）である点に注意
    def eol = '\n'

    //"\n" とするには以下のように skipWhitespace を false にする必要あり
    //override val skipWhitespace = false
    //def eol = "\n"
}

val csv = Source.stdin.mkString
println(SimpleCsv.parseAll(SimpleCsv.csvFile, csv))

Scala版実行結果

> scala parse_simple_csv.scala < test_simple.csv
[3.1] parsed: List(List(1, test1, 10.5), List(2, "test2", -123, abc))

複雑なCSV

次に、以前使用した CSV ファイル（要素内にコンマ・改行・ダブルクォーテーションあり）をパースするサンプルです。

test.csv

1,テスト1,"改行
含み"
2,test2,"カンマ,含み"
3,てすと3,"ダブルクォーテーション""含み"

単純なCSVと同様に、Haskell版は本の内容とほとんど同じです。
try を使ってダブルクォーテーションを要素内に含むケースに対応しています。

Haskell版 parse_csv.hs

import Text.ParserCombinators.Parsec

csvFile = endBy line eol
line = sepBy cell (char ',')
cell = quotedCell <|> many (noneOf ",\n")
eol = char '\n'
quotedCell = do 
    char '"'
    content <- many quotedChar
    char '"'
    return content

quotedChar = noneOf "\"" <|> try (string "\"\"" >> return '"')

main = do
    cs <- getContents
    let res = parse csvFile "" cs

    case res of
        Left err -> print err
        Right x -> putStrLn $ show x|

Haskell版実行結果

> runhaskell parse_csv.hs < test.csv
[["1","\131e\131X\131g1","\137\252\141s\n\138\220\130\221"],
["2","test2","\131J\131\147\131},\138\220\130\221"],
["3","\130\196\130\183\130\198\&3","\131_\131u\131\139\131N\131H\129[\131e\129[\131V\131\135\131\147\"\138\220\130\221"]]

分かりにくいかと思いますが、一応 \n , " が要素内に含まれている事が確認できます。

次に、Scala版です。
Haskell の try の代わりに guard() を使って同等の実装ができると思ったのですが、Haskell と同じように実装すると処理が返って来なくなってしまったので（実装の仕方が間違っている可能性あり）、とりあえず別の処理内容で実装する事にしました。

一応、ダブルクォーテーションの含まない文字列同士の区切りに "" が使われるという考え方で実装してみました。（要素内の " が消えるので repsep は使用せず）

なお、Scala では行の最後の要素がダブルクォーテーションで囲まれている場合に、改行が \r\n にマッチするという不可解な現象が発生したため、eol に | "\r\n" を加えました。（ダブルクォーテーションで囲まれていない場合は \n にマッチする）

また、今回は whiteSpace（正規表現的には \s+）がスキップされては困るので、skipWhitespace を false にしています。

Scala版 parse_csv.scala

import scala.io.Source
import scala.util.parsing.combinator._

object Csv extends JavaTokenParsers {
    override def skipWhitespace = false

    def csvFile = rep(line <~ eol)
    def line = repsep(cell, ',')
    //最後のセル要素に改行が含まれるので trim で取り除く
    def cell = quotedCell | """[^,\n]*""".r ^^ (_.trim)
    //quotedCellが行の最後に来た場合のみ \r\n になる
    def eol = "\n" | "\r\n"
    def quotedCell = '"' ~> quotedChars ~ rep(escapeQuotedChars) <~ '"' ^^ {case(x~xs) => x + xs.mkString}
    def quotedChars = """[^"]*""".r
    def escapeQuotedChars = "\"\"" ~> quotedChars ^^ ('"' + _)
}

val csv = Source.stdin.mkString
println(Csv.parseAll(Csv.csvFile, csv))

Scala版実行結果

> scala parse_csv.scala < test.csv
[5.1] parsed: List(List(1, テスト1, 改行
含み), List(2, test2, カンマ,含み), List(3, てすと3, ダブルクォーテーション"含み))

2010-12-13

Groovy, Scala, F#, Haskell による関数・クロージャの合成

Groovy Scala .NET F# Haskell

Groovy 1.8 のクロージャ合成の機能を試したついでに、Scala, F#, Haskell での関数合成の機能も簡単にまとめてみました。

サンプルのソースコードは http://github.com/fits/try_samples/tree/master/blog/20101213/

Groovy の場合

Groovy では >> や << を使います。（1.8 から導入された Closure composition の機能）

Groovy 1.8.0 beta2

compose_sample.groovy

def plus = {x -> x + 3}
def times = {x -> x * 2}

def f = plus >> times
def g = plus << times

// times(plus(4)) = 14
println f(4)
// plus(times(4)) = 11
println g(4)

Scala の場合

Scala では andThen や compose 等を使います。

Scala 2.8.1

compose_sample.scala

val plus = (x: Int) => x + 3
val times = (x: Int) => x * 2

val f = plus andThen times
val g = plus compose times

// times(plus(4)) = 14
println(f(4))
// plus(times(4)) = 11
println(g(4))

F# の場合

F# では Groovy と同様に >> や << を使います。

F# 2.0.0

compose_sample.fs

let plus x = x + 3
let times x = x * 2

let f = plus >> times
let g = plus << times

// times(plus(4)) = 14
printfn "%i" (f 4)
// plus(times(4)) = 11
printfn "%i" (g 4)

Haskell の場合

Haskell では . を使います。

HaskellPlatform 2010.2.0.0 (GHC 6.10.4)

plus x = x + 3
times x = x * 2

f = times . plus
g = plus . times

main = do
    -- times(plus(4)) = 14
    putStrLn $ show $ f 4
    -- plus(times(4)) = 11
    putStrLn $ show $ g 4

2010-11-06

Haskell で UTF-8 メールを送信 - SMTPClient 使用

Haskell

前回 id:fits:20101101 にて Scala や F# で実装したメールの送信処理を Haskell で実装してみました。

メール送信には HaskellNet を使う方法もあるようですが、今回は SMTPClient を使いました。

HaskellPlatform 2010.2.0.0 (GHC 6.10.4)
SMTPClient 1.0.3

なお、メール送信処理の仕様は id:fits:20101101 と同じです。（Shift_JIS の実行時引数と標準入力を UTF-8 に変換して送信）

サンプルのソースコードは http://github.com/fits/try_samples/tree/master/blog/20101106/

事前準備

必要なパッケージを cabal コマンドでインストールします。

> cabal install hsemail
> cabal install SMTPClient
> cabal install base64-string

iconv パッケージもインストールしておきます。（手順は id:fits:20101105 参照）

簡単なメール送信

まず、エンコード処理は行わずにメール送信する処理です。入力文字のままメール送信されます。（Content-Type などのメールヘッダー無し）

send_mail_simple.hs

import System
import Network.SMTP.Simple

main = do
    args <- getArgs
    -- メール本文（標準入力から取得）
    body <- getContents
    -- Fromメールアドレスからドメイン部分を取得
    let domain = tail $ snd $ break (== '@') $ args !! 1
    -- メッセージ作成
    let msg = SimpleMessage [NameAddr Nothing (args !! 1)] [NameAddr Nothing (args !! 2)] (args !! 3) body
    -- メール送信
    sendSimpleMessages putStr (head args) domain [msg]

ちなみに、sendSimpleMessages を使ったメールの送信では SMTP サーバーの IP アドレスを指定する必要があります。（ホスト名は使えない）

実行例

> runhaskell send_mail_simple.hs 192.168.1.1 xxxx@xxx.com xxxx@xxx.com "テストノート by Haskell" < mail.txt

UTF-8 のメール送信

SMTPClient で妥当な UTF-8 のメールを送信するには、自前でエンコードまわりの処理を実装する事になると思います。

他のプログラム言語なら、Network.SMTP.Simple の toMessage 関数の処理内容を実行時に書き換えるような方法で解決するところですが。

Haskell でそのような手段が可能かどうか判らなかったので、今回は Network.SMTP.Simple の toMessage と sendSimpleMessages を参考に自前で実装してみました。（toMimeMessage と sendMimeMessage）

メールヘッダーの Content-Type や Content-Transfer-Encoding の設定は、Message の OptionalField を使い、Codec.Binary.Base64.String の encode を使って BASE64 エンコードしています。（文字コード変換は iconv 使用）

なお、今回の方法で BASE64 エンコードすると文字列の長さに応じて自動的に改行が入るようになっているので、Subject に使う場合は各行に "=?UTF-8?B?" と "?=" が付くよう処理しています。

send_mail.hs

import System
import System.Time (CalendarTime(..), getClockTime, toCalendarTime)
import Network.Socket (SockAddr(..), inet_addr)
import Network.SMTP.Client
import Network.SMTP.Simple
import Codec.Text.IConv (convert)
import qualified Data.ByteString.Lazy.Char8 as C
import qualified Codec.Binary.Base64.String as B

sourceEncode = "Shift_JIS"
targetEncode = "UTF-8"

-- 文字コード変換
convertEncode :: String -> String
convertEncode s = C.unpack $ convert sourceEncode targetEncode $ C.pack $ s

--Base64エンコード
encodeBase64 :: String -> String
encodeBase64 s = B.encode $ convertEncode s

-- ヘッダー用Base64エンコード（encodeBase64 の結果に改行が入るケースを考慮）
encodeBase64Header :: String -> String
encodeBase64Header s = unlines $ map addEncodeInfo $ lines $ encodeBase64 s

-- エンコード情報を付与
addEncodeInfo :: String -> String
addEncodeInfo s = "=?" ++ targetEncode ++ "?B?" ++ s ++ "?="

-- Mime用メッセージ変換
toMimeMessage :: CalendarTime -> SimpleMessage -> Message
toMimeMessage ct sm =
    Message
        [
            From (from sm), 
            To (to sm), 
            Subject (encodeBase64Header $ subject sm), 
            Date ct,
            OptionalField "Content-Type" ("text/plain; charset=" ++ targetEncode),
            OptionalField "Content-Transfer-Encoding" "BASE64"
        ]
        (encodeBase64 $ body sm)

-- Mimeメッセージ送信
sendMimeMessage :: String -> SimpleMessage -> IO()
sendMimeMessage smtpHostIp msg = do
    nowCT <- toCalendarTime =<< getClockTime
    -- Fromメールアドレスからドメイン部分を取り出し
    let heloDomain = tail $ snd $ break (== '@') $ nameAddr_addr $ head $ from msg
    hostAddr <- inet_addr smtpHostIp
    let smtpSockAddr = SockAddrInet 25 hostAddr
    -- メール送信
    sendRawMessages putStr smtpSockAddr heloDomain [toMimeMessage nowCT msg]

-- メイン処理
main = do
    args <- getArgs
    -- メール本文（標準入力から取得）
    body <- getContents
    -- メッセージ作成
    let msg = SimpleMessage [NameAddr Nothing (args !! 1)] [NameAddr Nothing (args !! 2)] (args !! 3) body
    -- メール送信
    sendMimeMessage (head args) msg

実行例

> runhaskell -liconv send_mail.hs 192.168.1.1 xxxx@xxx.com xxxx@xxx.com "テストノート by Haskell" < mail.txt

>>= の処理

sample.hs

実行結果

callCC の処理1

callcc_sample1.hs

実行結果

callCC の処理2

callcc_sample2.hs

実行結果

build.sbt

Haskell の場合

reader_sample.hs （Reader モナド）

実行結果

applicative_sample.hs （Applicative）

実行結果

Scalaz の場合

ReaderSample.scala （Reader モナド）

実行結果

ApplicativeSample.scala （Applicative）

実行結果

ArrowSample.scala （Arrow）

実行結果

3手先の位置

Haskell版 move_knight.hs

Haskell版の実行結果

Scala版 move_knight.scala

Scala版の実行結果

moveKnight の別実装 Scala版 move_knight2.scala

Scalaz版 MoveKnight.scala

Scalaz版の実行結果

build.sbt

N手先の位置

Haskell版 move_knight_many.hs

Haskell版の実行結果

Scalaz版 MoveKnightMany.scala

Scalaz版の実行結果

備考

Haskell版 length_compare.hs

実行結果

Scalaz で実装

build.sbt

Scalaz版 LengthCompare.scala

実行結果

他の実装方法 （結果は同じ）

単純なCSV

test_simple.csv

Haskell版 parse_simple_csv.hs

Haskell版実行結果

Scala版 parse_simple_csv.scala

Scala版実行結果

複雑なCSV

test.csv

Haskell版 parse_csv.hs

Haskell版実行結果

Scala版 parse_csv.scala

Scala版実行結果

Groovy の場合

compose_sample.groovy

Scala の場合

compose_sample.scala

F# の場合

compose_sample.fs

Haskell の場合

事前準備

簡単なメール送信

send_mail_simple.hs

実行例

UTF-8 のメール送信

send_mail.hs

実行例

他の実装方法（結果は同じ）