モナディックなパーサ・コンビネータFParsecを使おう。てゆうかParsec(Haskell)のApplicativeスタイルがやばい。
Parsec(Haskell)のApplicativeスタイルがやばすぎるので、FParsecでApplicativeスタイルしてみた。
FParsecとは
FParsec とは Haskell のパーサ・コンビネータライブラリ Parsec をF#に移植したものです*1。
では、パーサ・コンビネータとはなんでしょうか。簡単に言うとパーサ(構文解析)の関数を組み合わせることで、
新たに複雑なパーサを作り上げるための仕組み(フレームワーク)と考えておけばよいでしょう。ファイルやいろいろな型のデータの構文解析に力を発揮します。
構文解析といえば正規表現を思い浮かべる人も多いかもしれません。正規表現は多くの場合とても便利ですが、複雑なデータ構造を扱うには不向きです。
パーサ・コンビネータは、時に正規表現に対する“より良い代替案”になり得ます*2。
FParsecを用いることで、無限先読みの文脈依存文法を解析したり、BNF記法で表すような複雑なパーサも比較的簡単に作ることができます。
噂によるとHaskellのParsecはLL構文解析において最高の性能を発揮するそうです。FParsecも同じような雰囲気ですたぶん。
ということで、難しいことはよくわかりませんが、魔神英雄伝ワタルよろしくなんだか面白カッコ良さそうなので利用しない手はないです。
環境
F# 2.0.0
FParsec 0.8.0.0
準備１：FParsecをビルドする
FParsecを利用するには、まずここ から FParsec のソースコードをダウンロードし、適当なディレクトリに解凍してビルドします。すると、めでたくFParsec.dllとFParsecCS.dllを手に入れることができます。ありがたや。
準備２：参照設定とモジュールのオープン
さっそくFParsec.dllとFParsecCS.dllを参照設定に追加します。
そして、利用するFParsecの各モジュールをオープンします。
open System open FParsec.Primitives open FParsec.CharParsers open FParsec.Error
これでFParsecを利用する環境が手に入りました。やったね。
FParsec：パースの基本
FParsec - A Parser Combinator Library for F#に解説と基本的なサンプルコードが出ています。サンプルコードを動かすと、なんとなく雰囲気がつかめます。
ただ、ドキュメントの内容が古くなってしまっていて、すべてをそのまま適用できないのが残念なところです。
さっそく何かパースしてみましょう。
まったく面白くもなんともありませんが、例えば1つの文字をパースするパーサはこう書けます。
let test s = match run letter s with | Success (r,us,p) -> printfn "success: %A" r | Failure (msg,err,us) -> printfn "failed: %s" msg let _ = test "ふじこｌｐ777" let _ = test "1ふじこｌｐ777"
実行結果
success: 'ふ' failed: Error in Ln: 1 Col: 1 1ふじこｌｐ777 ^ Expecting: letter
letterの型はParser
正確には、unicode letter(System.Char.IsLetterがtrueを返すもの)をパースするシンプルなパーサです。
runはパーサと対象を受け取ってパースを実行して結果を返す関数で、
成功した場合はSuccess、失敗した場合はFailureを判別共用体 ParserResult<'Result,'UserState>で返します*3。
例の「"1ふじこｌｐ777"」のパースは、先頭が数字(System.Char.IsLetter('1')はfalse)なので失敗していることがわかります。
もちろん letter の他にも以下のような基本的なパーサがいくつも定義されています。
でもぶっちゃけ全然足りてないですね。字句解析を真面目にやるなら不足分は自分で作るしかないですね。
anyOf: string -> Parser<char,'u> 「任意の文字列(引数:string)に含まれるすべてのchar」をパース noneOf: string -> Parser<char,'u> 「任意の文字列(引数:string)に含まれるすべてのchar」を含まないパース asciiUpper: Parser<char,'u> ASCII letter (大文字)をパース asciiLower: Parser<char,'u> ASCII letter (小文字)をパース asciiLetter: Parser<char,'u> ASCII letterをパース upper: Parser<char,'u> unicode letter(大文字)をパース lower: Parser<char,'u> unicode letter(小文字)をパース digit: Parser<char,'u> 数字([0-9])をパース
ちなみに１つ以上の複数のunicode letter(System.Char.IsLetterがtrue)をパースするパーサはこう書けます。
let test2 s = match many1 letter |> run <| s with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg let _ = test2 "ふじこｌｐ777" let _ = test2 "1ふじこｌｐ777"
実行結果
['ふ'; 'じ'; 'こ'; 'ｌ'; 'ｐ'] Error in Ln: 1 Col: 1 1ふじこｌｐ777 ^ Expecting: letter
選択
(<|>)、choice関数
(<|>)演算子あるいは、choice関数でパーサを選択することができる。
意味としては、正規表現で言うところの「|」（どれかにマッチ）と同じと考えて差し支えはない。
ただし、(<|>)演算子は、常に左側の選択肢を最初に試すということには注意。
unicode letterあるいは数字に一致する１文字以上にパース
let ld = (letter <|> digit |> many1Chars) |> run <| "ABC12D34;EF5" match ld with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
実行結果
"ABC12D34"
もちろんコンピューテーション式で記述することもできる
let ld' = parse {let! anc = choice [letter;digit] |> many1Chars return anc} |> run <| "ABC12D34;EF5" match ld' with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg Console.WriteLine () |> ignore
(.>>)、(>>.)
括弧内の1つ以上の数字をcharのリストとしてパース
many1がみそですね。ただのmanyだと１文字もマッチしなくてもパースが成功します。
let e1 = run (pchar '(' >>. (many1 digit) .>> pchar ')') "(123456)" match e1 with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
実行結果
['1'; '2'; '3'; '4'; '5'; '6']
括弧内の1つ以上の数字をstringとしてパース
many1Charsがみそですね。ただのmanyCharsもmanyと同様に、１文字もマッチしなくてもパースが成功します。
let f = pchar '(' >>. (many1Chars digit) .>> pchar ')' |> run <| "(123456)" match f with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
実行結果
"123456"
unicode letterおよび#+.をパース（ただし、lowerは読み捨てる）
let notlower1 = (letter <|> anyOf "#+.") .>> manyChars lower |> manyChars |> run <| "F#C#C++javaVB.NET" match notlower1 with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
実行結果
"F#C#C++VB.NET"
連結
連結とはまさにパースとパースを繋ぎ合わせることです。
以下は、「unicode letterと数字が隣り合う文字列」に一致する１文字以上にパース
let cn = (pipe2 letter (many1Chars digit) (fun x y -> string(x)+string(y)) |> manyStrings) |> run <| "A1B2C345;D6" match cn with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
もちろんコンピューテーション式として記述することもできる
let cn' = parse {let! anc = letter let! d = many1Chars digit return string(anc)+string(d)} |> manyStrings |> run <| "A1B2C345;D6" match cn' with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
unicode letterと隣り合うセミコロンも許容する
let cn'' = parse {let! anc = letter let! d = many1Chars digit <|> (anyOf ";" |> many1Chars) return string(anc)+string(d)} |> manyStrings |> run <| "A1B2C3D;E45;F6" match cn'' with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
実行結果
"A1B2C3D;E45"
正規表現の併用
正規表現を使わない場合
let str = @"(*comme nt123a*)bc4d*)" let comment1 = pstring "(*" >>. many1Chars (choice [digit;letter;newline] ) .>> pstring "*)" |> run <| str match comment1 with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
正規表現を併用して使う
let comment2 = between (pstring "(*") (pstring "*)") (regex "[^*)]+") |> run <| str match comment2 with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
実行結果
"comme nt123a" "comme nt123a"
FParsecは正規表現の代替案になり得るのは間違いない。
しかし、正規表現の長所すべてを否定するものではない。
正規表現の長所はそのままFParsecの中で生かすことができる。
let kanji = regex "[一-龠]" <?> "kanji" let kr = kanji |> many1 |> run <| "読書百遍意自ずから通ず" match kr with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
実行結果
["読"; "書"; "百"; "遍"; "意"; "自"]
というように、正規表現を導入することで漢字のパーサを簡単かつ正確に作ることができます。
(<?>)演算子は、解析器が失敗したときのエラーメッセージをカスタマイズするためのものです。
とあるパーサをn回適用したパーサ
とあるパーサをn回適用したパーサを取得する関数repeatを定義する
let repeat n p = let rec repeat n p result = parse {if n > 0 then let! x = p let! xs = repeat (n - 1) p (result@[x]) return xs else return result} repeat n p []
unicode letterを読み捨てて、数字3桁をパースする
let d3 = letter <|> digit .>> many letter >>. repeat 3 digit |> run <| "aBc1234dEf" match d3 with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
実行結果
['1'; '2'; '3']
let w = repeat 3 (pstring "うぇ") |> run <| "うぇうぇうぇうぇうぇうえぇえぇええｗｗｗｗ" match w with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
実行結果
["うぇ"; "うぇ"; "うぇ"]
先読み
FParsecにはattemptがあって、これを使って先読みを表現することができる(Parsecでいうところのtryに相当)。
attemptは解析関数(Parser<_,_>)を１つ取って、解析が成功しなかった場合、attempは入力を消費しない。
なので、(<|>)演算子の左側でattempを使うと、attemp内での消費がなかったものとして右側を試しま。attemptって名前のとおりです。
let w2 = repeat 3 (pstring "うぇうぇ") |> run <| "うぇうぇうぇうぇうぇうえぇえぇええｗｗｗ" match w2 with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg let w3 = attempt (repeat 3 (pstring "うぇうぇ")) <|> (repeat 5 (pstring "うぇ")) |> run <| "うぇうぇうぇうぇうぇうえぇえぇええｗｗｗ" match w3 with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
実行結果
Error in Ln: 1 Col: 9 うぇうぇうぇうぇうぇうえぇえぇええｗｗｗ ^ Expecting: 'うぇうぇ' ["うぇ"; "うぇ"; "うぇ"; "うぇ"; "うぇ"]
単純なパーサ：郵便番号
郵便番号パーサ 正規表現
let r = parse {let! d = regex "^\d{3}-\d{4}$" in return d} let zip = (r, "001-0016") ||> run match zip with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
郵便番号パーサ 正規表現未使用
let zip2 = parse {let! p= pipe3 (repeat 3 digit) (pchar '-') (repeat 4 digit) (fun x y z -> x@[y]@z) do! notFollowedBy (digit <|> letter) return new string (List.toArray p)} |> run <| "001-0016" match zip2 with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
実行結果
"001-0016" "001-0016"
単純なパーサ：改行区切り
改行区切りでパースする
let pline = parse {let! first = anyChar if first = '\n' then return "" else let! txt = restOfLine return (first.ToString()+txt)} let strings' = run (many pline) "\n\nHoge1\nFuga\n\nPiyo" match strings' with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
内部的にどうなっているのか、もっと詳細な書き方をした場合
let pline': Parser<string, unit> = fun state -> let mutable str = null let newState = state.SkipRestOfLine(true, &str) if not (LanguagePrimitives.PhysicalEquality state newState) then Reply(str, newState) else Reply(Error, NoErrorMessages, newState) let strings'' = run (many pline') "\n\nHoge1\nFuga\n\nPiyo" match strings'' with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg
実行結果
[""; ""; "Hoge1"; "Fuga"; ""; "Piyo"] [""; ""; "Hoge1"; "Fuga"; ""; "Piyo"]
Applicativeスタイルがやばい
Applicativeのススメ - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20101211/1292021817
Real World Haskell - Chapter 16. Using Parsec Applicative functors for parsing
http://book.realworldhaskell.org/read/using-parsec.html
Applicativeスタイル*4がやばい。やばすぎるよ！
ということで、冒頭でも書いたが、FParsecでApplicativeスタイルしてみた。
module FParsec.Applicative open System open FParsec.Primitives open Microsoft.FSharp.Core.Operators.Unchecked /// ap :: Monad m => m (a -> b) -> m a -> m b let inline ap f a = f >>= fun f' -> a >>= fun a' -> preturn (f' a') /// (<*>) :: Applicative f => f (a -> b) -> f a -> f b let inline (<*>) f a = ap f a /// (<**>) :: Applicative f => f a -> f (a -> b) -> f b let inline apr f a = a <*> f let inline (<**>) f a = apr f a /// liftA :: Applicative f => (a -> b) -> f a -> f b let inline liftA f a = a |>> f /// (<$>) :: Functor f => (a -> b) -> f a -> f b let inline (<!>) f a = liftA f a /// (<$) :: Functor f => a -> f b -> f a let inline (<!) f a = preturn f .>> a let inline (!>) f a = f >>. preturn a /// liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c let inline liftA2 f a b = pipe2 a b f // preturn f <*> a <*> b let inline (<!!>) f a b = liftA2 f a b /// liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d let inline liftA3 f a b c = pipe3 a b c f let inline (<!!!>) f a b c = liftA3 f a b c /// ( *>) :: Applicative f => f a -> f b -> f b let inline ( *>) x y = x >>. y // liftA2 (fun _ z -> z) x y /// (<*) :: Applicative f => f a -> f b -> f a let inline ( <*) x y = x .>> y // liftA2 (fun z _ -> z) x y /// sequenceA :: Applicative f => [f a] -> f [a] let sequenceA ps = List.foldBack (liftA2 (fun x y -> x::y)) ps (preturn []) /// sequenceA_ :: Applicative f => [f a] -> f () let sequenceA_ ps = List.fold ( *>) (preturn ()) ps /// mapA :: Applicative f => (a -> f b) -> [a] -> f [b] let mapA f xs = sequenceA (List.map f xs) /// mapA_ :: Applicative f => (a -> f b) -> [a] -> f () let mapA_ f xs = sequenceA_ (List.map f xs) /// foreverA :: Applicative f => f a -> f b let rec foreverA a = a *> foreverA a /// asum :: Alternative f => [f a] -> f a let sumA ps = List.fold (<|>) (preturn defaultof<'a>) ps //filterA :: Applicative f => (a -> f Bool) -> f [a] -> f [a] let filterA f ps = let addIf x b xs = if b then x::xs else xs let consA x a = liftA2 (addIf x) (f x) a List.foldBack consA ([]) ps /// zipWithA :: Applicative f => (a -> b -> f c) -> [a] -> [b] -> f [c] let map2A f xs ys = sequenceA (List.map2 f xs ys) /// zipWithA_ :: Applicative f => (a -> b -> f c) -> [a] -> [b] -> f () let map2A_ f xs ys = sequenceA_ (List.map2 f xs ys) /// mapAndUnzipA :: Applicative f => (a -> f (b, c)) -> [a] -> f ([b], [c]) let mapAndUnzipA f xs = liftA List.unzip (mapA f xs) /// replicateA :: Applicative f => Int -> f a -> f [a] let replicateA n a = sequenceA (List.replicate n a) /// replicateA_ :: Applicative f => Int -> f a -> f () let replicateA_ n a = sequenceA_ (List.replicate n a) /// unlessA :: Applicative f => Bool -> f () -> f () let unlessA b a = if b then preturn () else a /// guardA :: Alternative f => Bool -> f () let guardA b = unlessA b (preturn ()) /// whenA :: Applicative f => Bool -> f () -> f () let whenA b a = if b then a else preturn ()
ということで、FParsecはHaskellのParsec同様にモナディックなパーサ・コンビネータであることがわかります。
ちなみに、コメントの型表記はHaskell形式です。
当然ながらF#的な型を表すものではありませんし正確でもありません。あしからず。
Applicativeスタイルを適用すると、
let foo m1 m2 f = parse {let! a= m1 let! b = m2 return f a b}
というように、コンピューテーション式でこう書いていたものが
let foo' m1 m2 f = f <!> m1 <*> m2
こう書けます。あらまあ、きれいにコンピューテーション式なスタイルがなくなりました。
(<!>)演算子と(<*>)演算子を隠してみると以下のようになります。
let foo' m1 m2 f = f m1 m2
これはつまり、Applicativeがf m1 m2 という関数適用の形になっていることを表します。
Applicaitveを用いると、パーサをとても自然に表現することができるということです。
これが Applicative (適用できる)と呼ばれる由来です。
CSVファイルのパース
リア充本としても知られる「Real World Haskell」に掲載されているParsecによるCSVファイルパーサのお手本。
http://book.realworldhaskell.org/read/using-parsec.html
import Text.ParserCombinators.Parsec csvFile = endBy line eol line = sepBy cell (char ',') cell = quotedCell <|> many (noneOf ",\n\r") quotedCell = do char '"' content <- many quotedChar char '"' <?> "quote at end of cell" return content quotedChar = noneOf "\"" <|> try (string "\"\"" >> return '"') eol = try (string "\n\r") <|> try (string "\r\n") <|> string "\n" <|> string "\r" <?> "end of line" parseCSV :: String -> Either ParseError [[String]] parseCSV input = parse csvFile "(unknown)" input main = do c <- getContents case parse csvFile "(stdin)" c of Left e -> do putStrLn "Error parsing input:" print e Right r -> mapM_ print r
実にエレガントですね。
何も考えずに、F#へ移植してみる
let quotedChar = noneOf "\"" <|> attempt (pstring "\"\"" >>. pchar '"') let quotedCell = pchar '"' >>. manyChars quotedChar .>> pchar '"' <?> "quote at end of cell" let cell = quotedCell <|> manyChars (noneOf ",\n\r") let line = sepBy cell (pchar ',') let eol = attempt (newline) <?> "end of line" let csvFile = sepEndBy line eol let parseCSV input = (csvFile, input) ||> run let ReadFile filename = System.IO.File.ReadAllText(filename,System.Text.Encoding.GetEncoding("UTF-8")) let csv = @"D:\test\Data\sample.csv" |> ReadFile match parseCSV csv with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg Console.ReadLine () |> ignore
なんという写経。
適用箇所少ないけど、Applicativeスタイルにしてみる。
open FParsec.Applicative let quotedChar = noneOf "\"" <|> attempt ('"' <! pstring "\"\"") let quotedCell = pchar '"' *> manyChars quotedChar <* pchar '"' <?> "quote at end of cell" let cell = quotedCell <|> manyChars (noneOf ",\n\r") let line = sepBy cell (pchar ',') let eol = attempt newline <?> "end of line" let csvFile = sepEndBy line eol let parseCSV input = (csvFile, input) ||> run let ReadFile filename = System.IO.File.ReadAllText(filename,System.Text.Encoding.GetEncoding("UTF-8")) let csv = @"D:\test\Data\sample.csv" |> ReadFile match parseCSV csv with | Success (r, s, p) -> printfn "%A" r | Failure (msg, err, s) -> printfn "%s" msg Console.ReadLine () |> ignore
ふつくしい…！
あわせて読みたい
マジあわせて読みたい。
シンプルで高速な構文解析ライブラリ「Parsec」を.NETで使う^^ - yuji1982の日記
http://d.hatena.ne.jp/yuji1982/20080627/1214558307
最強のパーザー、Parser Combinator - 純粋関数型雑記帳
http://d.hatena.ne.jp/tanakh/comment?date=20040730
正規表現を超える - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20090309/1236590230
正規表現ちっくなパーサーコンビネーター - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20110131/1296466529
Applicativeのススメ - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20101211/1292021817
Applicative よりも Monad の方が力が強い理由 - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20100525/1274744955
Parsing with applicative functors in F# - Bug squash
http://bugsquash.blogspot.com/2011/01/parsing-with-applicative-functors-in-f.html
例によるApplicativeパーシング
http://www.mokehehe.com/realworldhaskell/index.php?Parsec%20%A5%D1%A1%BC%A5%B7%A5%F3%A5%B0%A5%E9%A5%A4%A5%D6%A5%E9%A5%EA#content_1_11
F# FParsec で（とりあえず）Forthを作る - 還暦プログラマの挑戦(Haskell に挑む→F#による言語造り)
http://www.cmas60.com/FS/fparsec.php
最後に
関数型的であり、ひじょーにCOOOOLなApplicativeスタイルではありますが、
当然ながら、使いこなすにはある程度の関数脳レベルが要求されるので、素人にはおすすめできない諸刃の剣。
ですから「F#でそれをやる意味あんの？」と問われたら、「慣れれば意味あるけど、慣れないうちは爆死必至だよ。」とでも答えよう。
そもそも、F#には、コンピューテーション式という、すばらしく可読性の高いステキスタイルがあらかじめ言語レベルで用意されているので、
あなたが、より意味を伝えるよう意識してコードを記述する善良なプログラマならば、わざわざApplicativeにする理由はこれっぽっちもない。
FParsecでのApplicativeスタイルは、まぎれもなく変態さん向け。変態さん個人で利用する場合、もしくは変態さんが
変態さんとコミュニケーションするためにはこの上ない良いツールです。それ以外のケースではうまく機能しないことは言うまでもありません。
なにはともあれ、FParsecは良い道具です。ご賞味あれ。
F#で継続渡し形式(CPS)変換を抽象的に考えてみたら、それってつまりHaskellの継続モナドみたいなものでした。ということで継続ワークフロー(簡易版)作った。
[前置き]
継続とは
プログラミングにおいて「継続」とは、ある計算のある時点における「残りの計算」を表す概念のこと。つまり、ある計算過程の瞬間におけるその過程の未来全体を表すものを意味する。
プログラミング言語で継続を扱う機能を導入すると、ユーザによるプログラムの実行順序の制御が可能になる。
プログラミングスタイルとして継続を表現したのが、継続渡しスタイルである。
詳しくは、下記のページを参照されたい。
なんでも継続
http://practical-scheme.net/docs/cont-j.html
継続渡し形式(CPS)とは
継続渡しスタイル(Continuation Passing Styleの頭文字をとってCPS)は、実際のプログラムの中では継続をクロージャとしてコールバック関数として渡すような関数を定義するプログラミングスタイルのこと。
[本題]
F#で継続渡しスタイル(CPS)変換を抽象的に考えてみたら、それってつまりHaskellの継続モナドみたいなものでした。
檜山正幸のキマイラ飼育記 - CPS（継続渡し方式）変換をJavaScriptで説明してみるべ、ナーニ、たいしたことねーべよ
http://d.hatena.ne.jp/m-hiyama/20080116/1200468797
を読んでいて、「CPS変換を行うメタメタ関数」ってのが面白いなあと思いまして、
継続渡しスタイル(CPS)を抽象的に考えて、F#でもCPS変換を簡易的に行えるメタメタ関数を作ったら面白そうかなと考えていました。
しばらくして、そういえばHaskellにそんなんあったっけなあ・・。そこで思い出したのがHaskellの継続モナド。
モナドのすべてより「Continuationモナド(継続モナド)」
http://www.sampou.org/haskell/a-a-monads/html/contmonad.html
上記リンク先の説明にあるように、継続モナドはCPSの計算を抽象的に表現しているモナドです。
継続渡しスタイルな関数(以下CPS関数)は、引数に関数をとり、自身の処理の最後でその関数(継続)を呼ぶというもので、CPS関数に継続として別のCPS関数を渡し、その別のCPS関数に継続として更に別のCPS関数を渡してゆく連鎖、つまりCPS関数のネストが、全体として継続渡しスタイルなプログラムを形成することになる。
CPS関数をモナドにくるんで >>=(bind関数)で繋ぐことで、継続モナドはCPS変換を行うメタメタ関数な表現を実現していると言える。
F#で継続ワークフロー(簡易版)を作ってみましょう
よろしいならばF#で継続ワークフローだ。ということで、簡易なCPS変換をサポートする継続ワークフローを作ってみる。
ContinuationWorkflow.fs
#light namespace Workflow ///継続ワークフロー type ContinuationBuilder() = ///CPS変換します member this.Return(a) = fun k -> k a ///継続バインド member this.Bind(m,f) = fun k -> m (fun a -> f a k) module ContinuationWorkflow = ///ContinuationBuilderを生成します let cps = new ContinuationBuilder()
たったこんだけです。基本的にHaskellの継続モナドからパクっただけみたいなってゆー(笑
モナドで包む部分とcallCCについては、よくわからない＆面倒くさい＆今回の主目的ではないので華麗にスルーしました。
newtype Cont r a = Cont { runCont :: ((a -> r) -> r) } instance Monad (Cont r) where return a = Cont $ \k -> k a (Cont c) >>= f = Cont $ \k -> c (\a -> runCont (f a) k) class (Monad m) => MonadCont m where callCC :: ((a -> m b) -> m a) -> m a instance MonadCont (Cont r) where callCC f = Cont $ \k -> runCont (f (\a -> Cont $ \_ -> k a)) k
継続ワークフローをお試し
では、さっそく継続ワークフローを味見してみる。ContinuationWorkflowTest.fs
#light open System open Workflow.ContinuationWorkflow module CpsTest = let Test1 = let f x = cps {return "F",x } let sharp (x,y) = cps {return x + "#", y} let beginner (x,y) = cps {return y + "は" + x + "初心者です。"} let expert (x,y) = cps {return y + "は" + x + "達人です。"} //継続ワークフローで継続渡しスタイル (遅延評価) let fsharp x = cps {let! a = f x let! b = sharp a match x with "zecl" -> let! c = beginner b return lazy c | _ -> let! c = expert b return lazy c } //お試し printfn "%s" <| fsharp "zecl" (fun x -> x.Force ()) printfn "%s" <| fsharp "Don Syme" (fun x -> x.Force ()) printfn "" let Test2 = //ふつうのフィボナッチ数列 let rec fibo n = if n <= 1 then 1 else fibo (n - 1) + fibo (n - 2) //継続渡しスタイルで書いたフィボナッチ数列 let rec fiboCps n cont = if n <= 1 then cont 1 else fun x -> fiboCps (n - 2) <| fun y -> cont (x + y) |> fiboCps (n - 1) //継続渡しスタイルのフィボナッチ数列関数で周期 (遅延評価) let fiboCpsCycle n m = cps {let! a = fiboCps n return lazy (a % m) } //ふつうのフィボナッチ関数を継続ワークフローで継続渡しスタイルに let fibo2 n = cps {return fibo n} //継続ワークフローでCPS変換したfibo2を使って周期 (遅延評価) let fibo2Cycle n m = cps {let! a = fibo2 n return lazy (a % m) } //print_anyして改行 let panyn = print_any >> Console.WriteLine //お試し for i = 0 to 10 do (fibo i |> panyn) printfn "" for i = 0 to 10 do (fiboCps i (fun x -> panyn x)) printfn "" for i = 0 to 10 do (fiboCpsCycle i 2 (fun x -> x.Force () |> panyn)) printfn "" for i = 0 to 10 do (fibo2Cycle i 2 (fun x -> x.Force () |> panyn)) #if COMPILED [<STAThread()>] do CpsTest.Test1 CpsTest.Test2 let key = Console.ReadKey () #endif
実行結果
zeclはF#初心者です。 Don SymeはF#達人です。 1 1 2 3 5 8 13 21 34 55 89 1 1 2 3 5 8 13 21 34 55 89 1 1 0 1 1 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1
これはやさしいCPS変換サポーターですね。
脳内CPS変換が苦手な人にもかなり有用だと思います。継続ﾜｰｸﾌﾛｰ(ﾟДﾟ)ｳﾏｰ!!!
ですが、多様は禁物。やはりご利用は計画的にといった感じでしょうか。
ちなみに、C#でもクロージャ(ラムダ式)が使えるので、C#で継続渡し形式っぽく
プログラムを書くことも可能といえば可能なんだけど、
可読性やパフォーマンスの観点から言って、C#でやる意味は皆無っぽいですね。
F#でStateモナドしてみよう。そうですよね、副作用は怖いですものね。
id:NobuhisaさんのWorkflowでモナド - (hatena (diary ’Nobuhisa))に触発されてF#でStateモナドしてみました。
ですが、Haskellのド素人でF#初心者なのでいろいろと間違っているかもしれません。
とりあえず的に、取り急ぎコードをうｐしておきます。(F#CTP)
後日、加筆修正するつもりです。
F#でStateモナド
StateMonad.fs
#light namespace Monad ///Stateモナドの器だよ type State<'s, 'a> = State of ('s ->'a * 's);; ///StateBuilderだよ type StateBuilder () = member this.Bind(m, f) = State <| fun s -> let r = match m with | State f -> f s match r with | (v,s) -> match f v with | State f -> f s member this.Return x = State <| fun s -> x, s ///Stateモナドの操作を提供するよ module StateMonad = ///StateBuilderを生成するよ let state = StateBuilder () ///状態を取得するよ。 let Get = fun _ -> State <| fun s -> (s, s) ///状態を更新するよ let Put s = State <| fun _ -> ((), s) ///状態から取得した「値」に関数を適用するよ。(Getの高階関数版) let Gets f = state { let! s = Get () return (f s) } ///関数を適用して状態を更新するよ。(Putの高階関数版) let Modify f = state { let! s = Get () do! Put (f s) } ///Stateモナドを使って行った計算結果(コンテナ)を取得するよ。 let Run (State s) = s ///評価した結果の値を取得するよ。 let Eval (State s) = s >> fst ///実行された状態を取得するよ。 let Exec (State s) = s >> snd
Stateモナドを試してみる
Program.fs
#light open System open Monad.StateMonad module StateTest = type day = | None = 0x0000 | Asa = 0x0001 | Hiru = 0x0002 | Ban = 0x0004 let panyn x = x |> (print_any >> Console.WriteLine) let Test1 = // let s = state // { let! b = Get () // do! Put (b - 5) // let! a = Get () // return (b + 5) |> string // } let s = state { let! b = Gets ((+)5) do! Modify ((+) <| -5) return b |> string } let _ = s |> Run <| 12 |> panyn let _ = s |> Exec <| 12 |> panyn let _ = s |> Eval <| 12 |> panyn Console.WriteLine () () let Test2 = let s = state { let! s = Get () let change (d:day option) = match d with | Some (day.Asa) -> Some <| day.Hiru | Some (day.Hiru) -> Some <| day.Ban | Some (day.Ban) -> Some <| day.Asa | _ -> None do! Put (change s) return match s with | Some (day.Asa) -> Some <| "おはよう" | Some (day.Hiru) -> Some <| "こんにちわ" | Some (day.Ban) -> Some <| "こんばんわ" | _ -> None } let _ = s |> Run <| Some (day.Asa) |> panyn let _ = s |> Run <| Some (day.Hiru) |> panyn let _ = s |> Run <| Some (day.Ban) |> panyn let _ = s |> Run <| Some (day.None) |> panyn Console.WriteLine () let _ = s |> Exec <| Some (day.Asa) |> panyn let _ = s |> Exec <| Some (day.Hiru) |> panyn let _ = s |> Exec <| Some (day.Ban) |> panyn let _ = s |> Exec <| Some (day.None) |> panyn Console.WriteLine () let _ = s |> Eval <| Some (day.Asa) |> panyn let _ = s |> Eval <| Some (day.Hiru) |> panyn let _ = s |> Eval <| Some (day.Ban) |> panyn let _ = s |> Eval <| Some (day.None) |> panyn () #if COMPILED [<STAThread()>] do StateTest.Test1 Console.WriteLine () StateTest.Test2 let key = Console.ReadKey () #endif
実行結果
("17", 7) 7 "17" (Some "おはよう", Some Hiru) (Some "こんにちわ", Some Ban) (Some "こんばんわ", Some Asa) (null, null) Some Hiru Some Ban Some Asa None Some "おはよう" Some "こんにちわ" Some "こんばんわ" None
あ、「///」でコメント付けたら、C#等のXMLコメントみたいに、
インテリセンス表示時にちゃんと説明が表示されるんですね。
今の今まで気付きませんでしたｗ
拡張ユークリッド互除法も再帰で書いた方が自然に見える
最適化のために最大公約数を求める必要があって、
ユークリッド互除法と拡張ユークリッド互除法を書いたので、チラ裏に残しておく*1。
ユークリッド互除法
まずはよく見る実装をC#で
public static int Gcd(int a, int b)
{
while (b != 0)
{
int r = a % b;
a = b;
b = r;
}
return a;
}
実にありがちな実装なのですが、どう見てもダサすぎ。
これってつまり、こういうことだよね。
public static int GcdR(int a, int b)
{
if (b == 0) return a;
return GcdR(b, a % b);
}
スッキリしました。
何を思ったか、久々にHaskellでも書いてみることに。
って、実はHaskellでは最初からgcd関数が定義されていたりする。
http://www.zvon.org/other/haskell/Outputprelude/gcd_f.html
なので
main :: IO() main = return (gcd 1029 1071) >>= print
これで、21って答えが出ちゃったりする。
でも、自分で書いてみることに意味があるよね。たぶん。
gcd2 :: Int -> Int -> Int gcd2 a 0 = a gcd2 a b = gcd2 b (rem a b)
こんだけ。書くまでもなかった。
拡張ユークリッド互除法
よく見る実装をC#で。
public static int GcdEx(int a, int b)
{
int x1 = 0;
int x2 = 1;
int y1 = 1;
int y2 = 0;
int r1 = b;
int r2 = a;
while (true)
{
if (r1 == 0) return r2;
//Math.DivRemなんてのもあるけど
int q = (int)Math.Floor((double)(r2 / r1));
int r = r2 % r1;
int x = x2 - q * x1;
int y = y2 - q * y1;
if (r == 0) break;
x2 = x1;
x1 = x;
y2 = y1;
y1 = y;
r2 = r1;
r1 = r;
}
return r1;
}
うへ。これはひどい・・・。
なんというローカル変数の乱立ｗｗｗ
これも再帰で表現したほうがスッキリできそうです。
実際に書いてみると、こんな感じでした。
private delegate TResult Func<T1, T2, T3, T4, T5, T6,TResult>(T1 a1, T2 a2, T3 a3, T4 a4, T5 a5, T6 a6);
public static int GcdExR(int a, int b)
{
Func<int, int, int, int, int, int, int> f = null;
f = (a2, b2, w2, x2, y2, z2) =>
{
if (b2 == 0) return a2;
return f(b2, a2 % b2, x2, (w2 - a2) / b2 * x2, z2, (y2 - a2) / b2 * z2);
};
return f(a, b, 1, 0, 0, 1);
}
いざ書いてみると、引数を６つとるFuncがないことに気付く…ｗ
一見わかりにくそうに見えるかもしれませんが、個人的には上に書いたよく見る実装よりも、
こちらの方が好みです。書き方的に「今風」っぽいというのも含めて。
あと、ラムダ式ばっか書いてると、匿名delegateでの旧式な書き方を忘れ気味であることに気付いた俺ガイル。
締めにHaskellでも
gcdex :: Int -> Int -> Int gcdex a b = gcdex' a b 1 0 0 1 where gcdex' a 0 _ _ _ _ = a gcdex' a b w x y z = gcdex' b r y z (w-y*q) (x-z*q) where (q, r) = quotRem a b
こうしてみると、やっぱHaskellはクールだなあ。
*1:負の数に関しては考えていません
Project Euler第1問目
Project Eulerはじめました。（冷やし中華的な意味で)
問題
If we list all the natural numbers below 10 that are multiples of 3 or 5, we get 3, 5, 6 and 9. The sum of these multiples is 23.
Find the sum of all the multiples of 3 or 5 below 1000.
10未満の自然数のうち、3 もしくは 5 の倍数になっているものは 3, 5, 6, 9 の4つがあり、これらの合計は 23 になる。
同じようにして、1,000 未満の 3 か 5 の倍数になっている数字の合計を求めよ。
http://projecteuler.net/index.php?section=problems&id=1
Haskellでの解答
{-Project Euler Q001-} main :: IO() main = return (answer [1..999]) >>= print answer :: [Int] -> Int answer = sum . map judge judge :: Int -> Int judge x | x `mod` 3 == 0 || x `mod` 5 == 0 = x | otherwise = 0
C#3.0での解答
using System; using System.Linq; namespace ConsoleApplication1 { class Program { static void Main() { (from num in Enumerable.Range(1, 999) where num % 3 == 0 || num % 5 == 0 select num).Aggregate(Enumerable.Repeat(default(int), 1), (nums, i) => from num in nums select num + i ).ToList().ForEach(i => Console.WriteLine(i.ToString())); Console.ReadLine(); } } }
実行結果
233168
暇をみて、解けるものだけでも解いていこうと思います。へっぽこなりに(^ω^;)
いまさら聞けないアルゴリズム その１「ハノイの塔」 Part.2
前回に引き続きまして、Haskell版「ハノイの塔」も書いてみた。
{-ハノイの塔-} main :: IO () main = putStr $ concat $ [write x | x <- hanoi "A" "B" "C" 3] hanoi :: String -> String -> String -> Int -> [(String, String)] hanoi _ _ _ 0 = [] hanoi a b c n = hanoi a c b (n - 1) ++ [(a, b)] ++ hanoi c b a (n - 1) write :: (String, String) -> String write x = (fst x) ++ " -> " ++ (snd x) ++ "\n"
実行結果
A -> B
A -> C
B -> C
A -> B
C -> A
C -> B
A -> B
やっぱり、再帰は関数型言語の方が断然美しく書ける感じだ。
というか、ひさびさにHaskell書いたら若干忘れかけてた(^ω^;)
Haskellで虫食い算的なもの
後日LINQで解いてみた、LINQで虫食い算的なものはこちらです。
虫食い算を解く
{-虫食い算-} -- ４○○ -- × ○○ -- -------- -- ○○○○○ -- ※ただし、○には４を除く０〜９の数字を１つずつ使用 -- また、桁の先頭は０ではないこと。 import Control.Monad num = [0..3]++[5..9] main :: IO () main = return answer >>= print answer :: [[Int]] answer = do a <- num b <- num ; guard $ notElem b [a] c <- num ; guard $ notElem c [a,b] ; guard $ c /= 0 d <- num ; guard $ notElem d [a,b,c] e <- num ; guard $ notElem e [a,b,c,d] ; guard $ e /= 0 f <- num ; guard $ notElem f [a,b,c,d,e] g <- num ; guard $ notElem g [a,b,c,d,e,f] h <- num ; guard $ notElem h [a,b,c,d,e,f,g] i <- num ; guard $ notElem i [a,b,c,d,e,f,g,h] guard $ toint [4,a,b] * toint [c,d] == toint [e,f,g,h,i] return $ map toint [[4,a,b],[c,d],[e,f,g,h,i]] toint :: [Int] -> Int toint = foldl (\ i j -> 10*i+j) 0
実行結果
[[402,39,15678],[495,36,17820]]
はいよくできましたー
