printf系の "%A" 書式指定子における型の表示レイアウトのカスタマイズ
判別共用体を文字列として出力する際に、ケース識別子を宣言する型（判別共用体）の名前を含めたフルネームで文字列化したくなったときのお話。
たとえば、以下を実行すると
type Tree<'T> = | Leaf of 'T | Node of Tree<'T> * Tree<'T> let tree1 = Node(Node(Leaf("a"),Node(Leaf("b"),Node(Leaf("c"),Leaf("d")))),Node(Leaf("e"),Leaf("f"))) printfn "%A" tree1
次の出力結果を得られる。
Node (Node (Leaf "a",Node (Leaf "b",Node (Leaf "c",Leaf "d"))), Node (Leaf "e",Leaf "f"))
それを、以下のような感じに出力するようにしたい。というのが今回のお題。
Tree.Node (Tree.Node (Tree.Leaf "a",Tree.Node (Tree.Leaf "b",Tree.Node (Tree.Leaf "c",Tree.Leaf "d"))), Tree.Node (Tree.Leaf "e",Tree.Leaf "f"))
StructuredFormatDisplay属性を使う
Core.StructuredFormatDisplayAttribute クラス (F#) - MSDNライブラリ
この属性は、%A printf 書式設定やその他の 2 次元のテキストベースの表示レイアウトを使用する場合に、型を表示する既定の方法を指定するために使用されます。 このバージョンの F# で有効な値は、PreText {PropertyName} PostText 形式の値のみです。 プロパティ名は、オブジェクトそのものの代わりに評価および表示するプロパティを表します。
とある。これを使えば、型を表示する際のレイアウトを自由にカスタマイズすることができる。なお、"このバージョンの F# で有効な値は"とあるが、F#2.0からF#3.1までは変更はない(F#2.0より前は仕様が異なる)。
StructuredFormatDisplayAttribute。自作ライブラリをせっせとこさえていたり、某有名F# ライブラリのソースコード等を読んでたり、コンパイラのソースを見ていたりする人なら見覚えがあるかもしれないが、"%A"書式指定子の表示レイアウトをカスタマイズしたい場面はそんなに多くはないだろうし、そこそこマニアックな(割とどーでもいい)話題かもしれない。こちら、「実践F#」に載っていないというか、「Expert F#3.0」にも載ってなかったと思うし、いまのところ最新の言語仕様書であるところの「The F# 3.0 Language Specification」にも記載されていないようなので、言語仕様書熟読勢も把握できていない可能性がある。でも、「プログラミングF#」にはサラりと載っていたりする（！）。
単純な例
StructuredFormatDisplay属性を使った単純な例は以下のようになる（ここでは例として判別共用体を対象としているが、その限りではない）。
[<StructuredFormatDisplay("Hello{Display}!")>] type Hello = | Hello of string member private this.Display = match this with | Hello s -> sprintf ", %s" s let hello = Hello("F#") printfn "%A" hello
出力結果は以下のようになる。
Hello, F#!
使い方めちゃ簡単。
FizzBuzzしてみる
意味もなくFizzBuzzしてみます。
[<StructuredFormatDisplay("{Display}")>] type FizzBuzz = | FizzBuzz of Fizz * Buzz member private this.Display = let (|Mul|_|) x y = if y % x = 0 then Some(y / x) else None let fizzbuzz x y = let xy = x * y [1..100] |> List.map (function | Mul xy _ -> "FizzBuzz" | Mul x _ -> "Fizz" | Mul y _ -> "Buzz" | n -> string n) match this with | FizzBuzz (Fizz(x), Buzz(y)) -> fizzbuzz x y and Fizz = Fizz of int and Buzz = Buzz of int let fizzbuzz = FizzBuzz(Fizz(3),Buzz(5)) printfn "%A" fizzbuzz printfn "%s" <| fizzbuzz.ToString() printfn "%O" fizzbuzz
出力結果
["1"; "2"; "Fizz"; "4"; "Buzz"; "Fizz"; "7"; "8"; "Fizz"; "Buzz"; "11"; "Fizz"; "13"; "14"; "FizzBuzz"; "16"; "17"; "Fizz"; "19"; "Buzz"; "Fizz"; "22"; "23"; "Fizz"; "Buzz"; "26"; "Fizz"; "28"; "29"; "FizzBuzz"; "31"; "32"; "Fizz"; "34"; "Buzz"; "Fizz"; "37"; "38"; "Fizz"; "Buzz"; "41"; "Fizz"; "43"; "44"; "FizzBuzz"; "46"; "47"; "Fizz"; "49"; "Buzz"; "Fizz"; "52"; "53"; "Fizz"; "Buzz"; "56"; "Fizz"; "58"; "59"; "FizzBuzz"; "61"; "62"; "Fizz"; "64"; "Buzz"; "Fizz"; "67"; "68"; "Fizz"; "Buzz"; "71"; "Fizz"; "73"; "74"; "FizzBuzz"; "76"; "77"; "Fizz"; "79"; "Buzz"; "Fizz"; "82"; "83"; "Fizz"; "Buzz"; "86"; "Fizz"; "88"; "89"; "FizzBuzz"; "91"; "92"; "Fizz"; "94"; "Buzz"; "Fizz"; "97"; "98"; "Fizz"; "Buzz"] Program+FizzBuzz Program+FizzBuzz
この結果から、StructuredFormatDisplay属性を使って型の表示方法をカスタマイズしても、"%s"および"%O"書式指定子に影響を及ぼしていないことが確認できる。"%s"および"%O"書式指定子を指定した場合、いずれも結果的に対象オブジェクトについて Object.ToString仮想メソッドが呼び出されるかたちになるので、判別共用体の場合は既定では上記のように型名が出力される。
override this.ToString () = sprintf "%A" this.Displayというように、ToStringメソッドをオーバーライドする実装を追加すれば、いずれも "%A"書式指定子を指定した場合と同じ結果が得られるようになる。F#2.0より前のバージョンでは ToStringを経由して表示する際にStructuredFormatDisplay属性を参照していたようだが、F#2.0以降はToStringメソッドを経由する場合にはこれを参照しないよう仕様が変更された。
StructuredFormatDisplay属性で指定した{PropertyName}を実装していない場合
ちょっと例を変えて、レコード型にしてみる。
[<StructuredFormatDisplay("{AsString}")>] type myRecord = {value : int} override this.ToString() = "hello" //member this.AsString = this.ToString() let t = {value=5} printfn "%s" (t.ToString()) printfn "%O" t printfn "%A" t
出力結果
hello hello <StructuredFormatDisplay exception: メソッド 'Program+myRecord.AsString' が見つかりません。>
とまあ、StructuredFormatDisplay属性で指定した{PropertyName}を実装していない場合は、
コンパイルエラーとなるわけでなく例外となるわけでなく、割と残念な感じの出力結果を得ることになる。コンパイルエラーにしてくれてもいいのにー。
判別共用体(discriminated unions)について、型名も含めて文字列化する
さて、本題。
まずは愚直に書いてみよう
StructuredFormatDisplay属性でマークし、表示をカスタマイズする実装を愚直に書き加える。
[<StructuredFormatDisplay("{Display}")>] type Tree<'T> = | Leaf of 'T | Node of Tree<'T> * Tree<'T> member private t.Display = match t with | Leaf x -> sprintf "%s %A" "Tree.Leaf" x | Node (a,b) -> sprintf "%s %A" "Tree.Node" (a,b) let tree1 = Node(Node(Leaf("a"),Node(Leaf("b"),Node(Leaf("c"),Leaf("d")))),Node(Leaf("e"),Leaf("f"))) printfn "%A" tree1
以下の出力結果が得られる。
Tree.Node (Tree.Node (Tree.Leaf "a", Tree.Node (Tree.Leaf "b", Tree.Node (Tree.Leaf "c", Tree.Leaf "d"))), Tree.Node (Tree.Leaf "e", Tree.Leaf "f"))
おいおい。PreText使おうぜ
あっ。ケース識別子を宣言する型（判別共用体）の名前は固定なので、この場合StructuredFormatDisplay属性のPreTextに集約できるんだったね。
[<StructuredFormatDisplay("Tree.{Display}")>] type Tree<'T> = | Leaf of 'T | Node of Tree<'T> * Tree<'T> member private t.Display = match t with | Leaf x -> sprintf "%s %A" "Leaf" x | Node (a,b) -> sprintf "%s %A" "Node" (a,b) let tree1 = Node(Node(Leaf("a"),Node(Leaf("b"),Node(Leaf("c"),Leaf("d")))),Node(Leaf("e"),Leaf("f"))) printfn "%A" tree1
出力結果変わらず。
Tree.Node (Tree.Node (Tree.Leaf "a", Tree.Node (Tree.Leaf "b", Tree.Node (Tree.Leaf "c", Tree.Leaf "d"))), Tree.Node (Tree.Leaf "e", Tree.Leaf "f"))
このTree<'T>判別共用体の場合だけに関して言えば、とりあえずこれで良さそうに見えるし、この方法を取れば他の判別共用体についても都度対応できそうだ。 でも、毎回個別に対応するなんてダルすぎる。汎用的にしたいよねー。
リフレクションで汎用的に実装しよう
Microsoft.FSharp.Reflectionを利用する。
open Microsoft.FSharp.Reflection let stringifyFullName (discriminatedUnion:'T) = if box discriminatedUnion = null then nullArg "discriminatedUnion" if FSharpType.IsUnion(typeof<'T>)|> not then invalidArg "discriminatedUnion" (sprintf "判別共用体じゃないよ:%s" typeof<'T>.FullName) let info, objects = FSharpValue.GetUnionFields(discriminatedUnion, typeof<'T>) let typeName = if info.DeclaringType.IsGenericType then info.DeclaringType.Name.Substring(0, info.DeclaringType.Name.LastIndexOf("`")) + "." + info.Name else info.DeclaringType.Name + "." + info.Name match objects with | [||] -> typeName | elements -> let fields = info.GetFields() if fields.Length = 1 then sprintf "%s %A" typeName elements.[0] else let tupleType = fields |> Array.map( fun pi -> pi.PropertyType ) |> FSharpType.MakeTupleType let tuple = FSharpValue.MakeTuple(elements, tupleType) sprintf "%s %A" typeName tuple [<StructuredFormatDisplay("{ToStructuredDisplay}")>] type Tree<'T> = | Leaf of 'T | Node of Tree<'T> * Tree<'T> member private t.ToStructuredDisplay = t.ToString() override t.ToString () = stringifyFullName t let tree1 = Node(Node(Leaf("a"),Node(Leaf("b"),Node(Leaf("c"),Leaf("d")))),Node(Leaf("e"),Leaf("f"))) printfn "%A" tree1
出力結果
Tree.Node (Tree.Node (Tree.Leaf "a", Tree.Node (Tree.Leaf "b", Tree.Node (Tree.Leaf "c", Tree.Leaf "d"))), Tree.Node (Tree.Leaf "e", Tree.Leaf "f"))
ヽ(*´∀｀)ﾉ ﾜｰｲ、できたよー
と、思ったけど、待って。違うやん。本当は以下のようなレイアウトで表示したかったんだった（だった！）。
Tree.Node (Tree.Node (Tree.Leaf "a",Tree.Node (Tree.Leaf "b",Tree.Node (Tree.Leaf "c",Tree.Leaf "d"))), Tree.Node (Tree.Leaf "e",Tree.Leaf "f"))
んー、内容的には同じなのでそんなに大きな問題ではないんだけど、若干モヤッとする。
"%A" 書式指定子の表示レイアウトをいい感じに制御するにはどうすればよいのだろう？
また、既存の型（例えばOption<'T>型など）の、表示をカスタマイズしたい場合はどうすればよいのだろう？
F#er諸兄、何かご存じであればアドバイス頂きたい。
判別共用体で型付きDSL。弾幕記述言語BulletMLのF#実装、FsBulletML作りました。
この記事はF# Advent Calendar 2013の20日目です。
遅ればせながらThe Last of Usをちびちびとプレイ中。FF14のパッチ2.1が先日リリースされ、メインジョブ弱体化にもめげず引き続き光の戦士としてエオルゼアの平和を守り続けている今日この頃。艦これは日課です。はてなブログに引っ越してきて一発目（ブログデザイン模索中）です。気付けば半年もブログを書いていませんでした(テイタラク)。今年はあまり.NET関係の仕事に携わることができずに悶々としておりましたが、急遽C#の仕事が舞い込んできました。年末はいろいろとバタバタするものです。少しの間ホテル暮らしなのでゲーム(据置機)できなくてつらいです。わたしは大晦日にひとつの節目を迎えます。記憶力、体力、集中力...多くのものを失ったように思います。アラフォーいい響きです(白目)。
上の動画の弾幕は次のBulletml判別共用体で記述されています(MonoGameで動いています)。
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: |
#r @"bin\Debug\FsBulletML.Core.dll" open FsBulletML /// ぐわんげ、二面ボス by 白い弾幕くん /// [Guwange]_round_2_boss_circle_fire.xml let ``round_2_boss_circle_fire`` = "ぐわんげ、二面ボス by 白い弾幕くん", Bulletml ({bulletmlXmlns = Some "http://www.asahi-net.or.jp/~cs8k-cyu/bulletml"; bulletmlType = Some BulletVertical;}, [BulletmlElm.Fire ({fireLabel = Some "circle";}, Some (Direction (Some {directionType = DirectionType.Sequence;},"$1")), Some (Speed (None,"6")), Bullet ({bulletLabel = None;},None,None, [Action ({actionLabel = None;}, [Wait "3"; Fire ({fireLabel = None;}, Some (Direction (Some {directionType = DirectionType.Absolute;},"$2")), Some (Speed (None,"1.5+$rank")), Bullet ({bulletLabel = None;},None,None,[])); Vanish])])); BulletmlElm.Action ({actionLabel = Some "fireCircle";}, [Repeat (Times "18", Action ({actionLabel = None;}, [FireRef ({fireRefLabel = "circle";},["20"; "$1"])]))]); BulletmlElm.Action ({actionLabel = Some "top";}, [Action.ActionRef ({actionRefLabel = "fireCircle";},["180-45+90*$rand"]); Wait "10"])]) |
名前空間 FsBulletML
Multiple items
共用体ケース Bulletml.Bulletml: BulletmlAttrs * BulletmlElm list -> Bulletml
--------------------
type Bulletml =
| Bulletml of BulletmlAttrs * BulletmlElm list
| Action of ActionAttrs * Action list
| ActionRef of ActionRefAttrs * Params
| Fire of FireAttrs * Direction option * Speed option * BulletElm
| FireRef of FireRefAttrs * Params
| Wait of string
| Vanish
| ChangeSpeed of Speed * Term
| ChangeDirection of Direction * Term
| Accel of Horizontal option * Vertical option * Term
...
完全名: FsBulletML.DTD.Bulletml
共用体ケース Bulletml.Bulletml: BulletmlAttrs * BulletmlElm list -> Bulletml
--------------------
type Bulletml =
| Bulletml of BulletmlAttrs * BulletmlElm list
| Action of ActionAttrs * Action list
| ActionRef of ActionRefAttrs * Params
| Fire of FireAttrs * Direction option * Speed option * BulletElm
| FireRef of FireRefAttrs * Params
| Wait of string
| Vanish
| ChangeSpeed of Speed * Term
| ChangeDirection of Direction * Term
| Accel of Horizontal option * Vertical option * Term
...
完全名: FsBulletML.DTD.Bulletml
共用体ケース Option.Some: 'T -> Option<'T>
共用体ケース ShootingDirection.BulletVertical: ShootingDirection
type BulletmlElm =
| Bullet of BulletAttrs * Direction option * Speed option * ActionElm list
| Fire of FireAttrs * Direction option * Speed option * BulletElm
| Action of ActionAttrs * Action list
完全名: FsBulletML.DTD.BulletmlElm
| Bullet of BulletAttrs * Direction option * Speed option * ActionElm list
| Fire of FireAttrs * Direction option * Speed option * BulletElm
| Action of ActionAttrs * Action list
完全名: FsBulletML.DTD.BulletmlElm
共用体ケース BulletmlElm.Fire: FireAttrs * Direction option * Speed option * BulletElm -> BulletmlElm
Multiple items
共用体ケース Direction.Direction: DirectionAttrs option * string -> Direction
--------------------
type Direction = | Direction of DirectionAttrs option * string
完全名: FsBulletML.DTD.Direction
共用体ケース Direction.Direction: DirectionAttrs option * string -> Direction
--------------------
type Direction = | Direction of DirectionAttrs option * string
完全名: FsBulletML.DTD.Direction
共用体ケース DirectionType.Sequence: DirectionType
Multiple items
共用体ケース Speed.Speed: SpeedAttrs option * string -> Speed
--------------------
type Speed = | Speed of SpeedAttrs option * string
完全名: FsBulletML.DTD.Speed
共用体ケース Speed.Speed: SpeedAttrs option * string -> Speed
--------------------
type Speed = | Speed of SpeedAttrs option * string
完全名: FsBulletML.DTD.Speed
共用体ケース Option.None: Option<'T>
共用体ケース BulletElm.Bullet: BulletAttrs * Direction option * Speed option * ActionElm list -> BulletElm
Multiple items
共用体ケース ActionElm.Action: ActionAttrs * Action list -> ActionElm
--------------------
type Action =
| ChangeDirection of Direction * Term
| Accel of Horizontal option * Vertical option * Term
| Vanish
| ChangeSpeed of Speed * Term
| Repeat of Times * ActionElm
| Wait of string
| Fire of FireAttrs * Direction option * Speed option * BulletElm
| FireRef of FireRefAttrs * Params
| Action of ActionAttrs * Action list
| ActionRef of ActionRefAttrs * Params
完全名: FsBulletML.DTD.Action
共用体ケース ActionElm.Action: ActionAttrs * Action list -> ActionElm
--------------------
type Action =
| ChangeDirection of Direction * Term
| Accel of Horizontal option * Vertical option * Term
| Vanish
| ChangeSpeed of Speed * Term
| Repeat of Times * ActionElm
| Wait of string
| Fire of FireAttrs * Direction option * Speed option * BulletElm
| FireRef of FireRefAttrs * Params
| Action of ActionAttrs * Action list
| ActionRef of ActionRefAttrs * Params
完全名: FsBulletML.DTD.Action
共用体ケース Action.Wait: string -> Action
共用体ケース Action.Fire: FireAttrs * Direction option * Speed option * BulletElm -> Action
共用体ケース DirectionType.Absolute: DirectionType
共用体ケース Action.Vanish: Action
共用体ケース BulletmlElm.Action: ActionAttrs * Action list -> BulletmlElm
共用体ケース Action.Repeat: Times * ActionElm -> Action
Multiple items
共用体ケース Times.Times: string -> Times
--------------------
type Times = | Times of string
完全名: FsBulletML.DTD.Times
共用体ケース Times.Times: string -> Times
--------------------
type Times = | Times of string
完全名: FsBulletML.DTD.Times
共用体ケース Action.FireRef: FireRefAttrs * Params -> Action
共用体ケース Action.ActionRef: ActionRefAttrs * Params -> Action
FsBulletMLリリースしました
弾幕記述言語BulletMLのF#実装、FsBulletMLを作りました。Unity 4.3では新たに2Dがサポートされたりで、少なからず需要がないこともないのかもしれず。せっかくなので FsBulletML.Core(内部DSLを提供) および、FsBulletML.Parser(外部DSLを提供) をNuGetに放流してみました(Beta版)。実際に使える（使われる）ライブラリに成長するかどうかはわかりません。
BulletMLとは
BulletMLとは、シューティングゲームにおける弾幕を記述するための言語(外部DSL)で、多くのハイクオリティなシューティングゲームを開発なさっている ABA Games の 長健太氏が作りました。BulletMLが初めて公開されたのは2002年頃でしょうか？ もう10年以上前ということになります。シンプルな記述で多彩な弾幕を表現することができ、有限オートマトン的に弾を管理しなくてもよいので楽チン。ということで多くの人から注目を集めました。わたしが存在を知ったのはもう少し後のことですが、当時かなりインパクトを受けて感動したのを覚えています。
本家BulletMLのパーサおよび処理系はJavaで実装されています。RELAX定義、DTD定義など弾幕定義自体の簡易的な仕様については公式に公開されているものの、弾幕の処理系の詳細については「ソース嫁」状態という非常に漢気溢れる感じになっています*1。にもかかわらず、多くの人によって様々な言語で移植/実装/改良されています。BulletSML は、BulletMLのS式版(内部DSL)で、ひとつひとつの弾が継続になっているらしいです(あたまおかしい)。最近では、bulletml.js が内部DSLも提供していて、enchant.js用、tmlib.js用のプラグインもあって、ブラウザで動く弾幕ゲーが簡単に作れるようになっているようです。
特定の「何か」を達成するために、最適化された言語を作ることは簡単なことではありません。シンプルで且つ表現力が高くて実用的なドメイン固有言語を作る(デザインする）のはとても難しいことです。BulletMLはとてもよくデザインされていて面白くて魅力的なDSLだと思いました。
DSLについて
以前以下のような記事を書きました。
F#3.0で加速する言語指向プログラミング(LOP)。コンピューテーション式はもはやモナドだけのための構文ではない！！！
きっかけ
今年は例年に比べてIT系勉強会に参加できませんでしたが、夏に「コード書こうぜ！」をスローガンとしたCode2013という合宿イベントに参加しました。その中で、座談会orセミナー形式で複数グループが集まってそれぞれが異なるテーマについて話をする形の「きんぎょばち」というコーナーがありまして、「パーサコンビネータを使った構文解析およびDSLの作成などについて勉強したいです。」というテーマがありました。特定言語に限ったテーマではありませんが、他に「F# や 関数型言語の話題なら少し話せます。」というテーマもあったので、わたしが F# について話をする流れになって、判別共用体の便利さや FParsec を用いた字句解析、構文解析等についてお話してきました。本当は教えてもらいたい側だったのですが...。イベントから帰ってきてから、「何かDSL書きたいなー」と漠然とした思いを持っていました。
「BulletMLを 判別共用体で 型付きの内部DSLとして表現できるようにしたらちょっと面白いんじゃあ？」という発想。アイディアとしては３年くらい前から持っていましたが、実装が面倒くさいことになりそうだったので行動に至らずでした。ゲーム開発の世界ではDSLや各ドメインエキスパートのための独自スクリプト言語などを開発/運用することは日常茶飯事で、そう珍しいことではないと風のうわさで聞いたことがあります。わたし自身は、仕事であれ趣味であれ、日頃のソフトウェア開発において本格的なDSLを設計したり実装したりする機会はほとんどありません。非常に興味のある分野/開発手法なので実際に何かを作って勉強してみたい。そう兼ねてから思っていました。良い練習になりそうだし、"評論家先生"というYAIBAに影響を受けたりで、重い腰を上げました（よっこらせ）。
やりたかったこと
・ 弾幕を判別共用体で書きたい(型付き内部DSL)
・従来のXML形式での弾幕を再利用したい(外部DSL)
・XML形式は書きにくいしちょっと古臭い。XMLとは異なる形式の外部DSLも利用できるようにしたい。
要は、「内部DSLと複数の外部DSLを両立する。」ということをやってみたい。その辺りを最終的な目標にしました。そもそもC#での実装(BulletML C# - Bandle Games)があるし、何を今さら感があるのも事実ですが、判別共用体による型付き内部DSLを提供するという点で若干のアドバンテージがあります。型付きの内部DSLが使えると何がうれしいって、弾幕を構築する際にF#の式がそのまま使えるということです。つまり、関数を組み合わせて自由に弾幕を組み立てることができるようになります。それってつまり、Bulletsmorphのようなアイディアも実装しやすくなる、と。
今週土曜のCLR/H勉強会 http://t.co/Wsb4ddWyA2 で「ちょ、構成ファイルの書式に今どきXMLなんてありえないでしょww」「yamlかjsonだろ」「つーか.rbで構成書くよねふつー」とかXMLのdisり大会やってみたい。そこで「でもね...」#clrh86
— jsakamoto (@jsakamoto) 2013, 11月 6XMLのdisり大会。こちら結局どうなったんでしょう。気になります(´･_･`)
DTD定義を判別共用体で表現する
いにしえからの言い伝えによると、「判別共用体は、ドメイン知識をモデル化するための簡潔かつタイプセーフな方法である。」らしいです。
ということで、BulletML のDTD定義を内部DSLとして判別共用体で表現する。ということについて考えてみたい。
以前、こんなやり取りがありました。
判別共用体って、
type Hoge =
| A of Hoge.B * Hoge.C
| B of string
| C of int
みたいに書けないわけで。泥臭くならざるを得ない。
そりゃそうだろうっちゃーそりゃそうなのだが(´･_･`)つらぽよ #fsharp
— ぜくる (@zecl) 2013, 7月 8@gab_km そうなんですよ。どうしても泥臭くなってしまぅぅ...(´・ω・｀)
— ぜくる (@zecl) 2013, 7月 8@igeta 先の例は単純化したものでして。例としては微妙でしたね； twitterではうまく状況を説明しにくいのですが、やりたいのはそういうことではないのです。
— ぜくる (@zecl) 2013, 7月 8@gab_km 確かにそんなに多くはないんですが、型に厳格目というか、ちょっとコッたことをやろうと思うと…。先の例は単純化したもので、例としては微妙でした；
— ぜくる (@zecl) 2013, 7月 8@igeta ですです。そんな感じです。説明しなくても通じたー！（ぇ 何個も型を定義してどんどん煩雑化していくんですorz ある程度型を曖昧にすべきか。煩雑化してでも型に厳格にすべきか。設計次第といったところですが、悩ましいです^^;
— ぜくる (@zecl) 2013, 7月 8@igeta どちらかというと代数的データ型が(◞‸ლ)
— ぜくる (@zecl) 2013, 7月 8@igeta GADTsとかよくわかってない系おじさんですが、何か。
— ぜくる (@zecl) 2013, 7月 8言語内に型付きDSLを構築したいようなケースでは、GADT(Generalised Algebraic Datatypes)が欲しくなるようです。つまりこれ、抽象構文木なんかを型付きで表したいときに発生する事案です。しかし、F#にはHaskellのGADTsに相当するものはありません。GADT相当の表現自体はOOPスタイルで書けば可能ではありますが、判別共用体で内部DSLを表現したいというコンセプトとはズレてしまうので今回は適用できません。仕方がないので、型を細分化してどんどん型が絞られていくような型を定義します。
BulletMLのDTD定義に沿って、以下のような感じの型を定義すれば、判別共用体による内部DSLの構造(モロ抽象構文木)が表現できます。
/// BulletML DTD /// <!ELEMENT vertical (#PCDATA)> /// <!ATTLIST vertical type (absolute|relative|sequence) "absolute"> type Vertical = | Vertical of VerticalAttrs option * string and VerticalAttrs = { verticalType : VerticalType } and VerticalType = | Absolute | Relative | Sequence /// BulletML DTD /// <!ELEMENT param (#PCDATA)> type Params = string list /// BulletML DTD /// <!ELEMENT speed (#PCDATA)> /// <!ATTLIST speed type (absolute|relative|sequence) "absolute"> type Speed = | Speed of SpeedAttrs option * string and SpeedAttrs = { speedType : SpeedType } and SpeedType = | Absolute | Relative | Sequence /// BulletML DTD /// <!ELEMENT direction (#PCDATA)> /// <!ATTLIST direction type (aim|absolute|relative|sequence) "aim"> type Direction = | Direction of DirectionAttrs option * string and DirectionAttrs = { directionType : DirectionType } and DirectionType = | Aim | Absolute | Relative | Sequence /// BulletML DTD /// <!ELEMENT term (#PCDATA)> type Term = Term of string /// BulletML DTD /// <!ELEMENT times (#PCDATA)> type Times = Times of string /// BulletML DTD /// <!ELEMENT horizontal (#PCDATA)> /// <!ATTLIST horizontal type (absolute|relative|sequence) "absolute"> type Horizontal = | Horizontal of HorizontalAttrs option * string and HorizontalAttrs = { horizontalType : HorizontalType } and HorizontalType = | Absolute // Default | Relative | Sequence type BulletmlAttrs = { bulletmlXmlns : string option; bulletmlType : ShootingDirection option} and ShootingDirection = | BulletNone // Default | BulletVertical | BulletHorizontal type ActionAttrs = { actionLabel : string option } type ActionRefAttrs = { actionRefLabel : string } type FireAttrs = { fireLabel : string option } type FireRefAttrs = { fireRefLabel : string } type BulletAttrs = { bulletLabel : string option } type BulletRefAttrs = { bulletRefLabel : string } type Bulletml = /// BulletML DTD /// <!ELEMENT bulletml (bullet | fire | action)*> /// <!ATTLIST bulletml xmlns CDATA #IMPLIED> /// <!ATTLIST bulletml type (none|vertical|horizontal) "none"> | Bulletml of BulletmlAttrs * BulletmlElm list /// BulletML DTD /// <!ELEMENT action (changeDirection | accel | vanish | changeSpeed | repeat | wait | (fire | fireRef) | (action | actionRef))*> /// <!ATTLIST action label CDATA #IMPLIED> | Action of ActionAttrs * Action list /// BulletML DTD /// <!ELEMENT actionRef (param* )> /// <!ATTLIST actionRef label CDATA #REQUIRED> | ActionRef of ActionRefAttrs * Params /// BulletML DTD /// <!ELEMENT fire (direction?, speed?, (bullet | bulletRef))> /// <!ATTLIST fire label CDATA #IMPLIED> | Fire of FireAttrs * Direction option * Speed option * BulletElm /// BulletML DTD /// <!ELEMENT fireRef (param* )> /// <!ATTLIST fireRef label CDATA #REQUIRED> | FireRef of FireRefAttrs * Params /// BulletML DTD /// <!ELEMENT wait (#PCDATA)> | Wait of string /// BulletML DTD /// <!ELEMENT vanish (#PCDATA)> | Vanish /// BulletML DTD /// <!ELEMENT changeSpeed (speed, term)> | ChangeSpeed of Speed * Term /// BulletML DTD /// <!ELEMENT changeDirection (direction, term)> | ChangeDirection of Direction * Term /// BulletML DTD /// <!ELEMENT accel (horizontal?, vertical?, term)> | Accel of Horizontal option * Vertical option * Term /// BulletML DTD /// <!ELEMENT bullet (direction?, speed?, (action | actionRef)* )> /// <!ATTLIST bullet label CDATA #IMPLIED> | Bullet of BulletAttrs * Direction option * Speed option * ActionElm list /// BulletML DTD /// <!ELEMENT bulletRef (param* )> /// <!ATTLIST bulletRef label CDATA #REQUIRED> | BulletRef of BulletRefAttrs * Params /// BulletML DTD /// <!ELEMENT repeat (times, (action | actionRef))> | Repeat of Times * ActionElm | NotCommand and BulletmlElm = | Bullet of BulletAttrs * Direction option * Speed option * ActionElm list | Fire of FireAttrs * Direction option * Speed option * BulletElm | Action of ActionAttrs * Action list and Action = | ChangeDirection of Direction * Term | Accel of Horizontal option * Vertical option * Term | Vanish | ChangeSpeed of Speed * Term | Repeat of Times * ActionElm | Wait of string | Fire of FireAttrs * Direction option * Speed option * BulletElm | FireRef of FireRefAttrs * Params | Action of ActionAttrs * Action list | ActionRef of ActionRefAttrs * Params and BulletElm = | Bullet of BulletAttrs * Direction option * Speed option * ActionElm list | BulletRef of BulletRefAttrs * Params and ActionElm = | Action of ActionAttrs * Action list | ActionRef of ActionRefAttrs * Params
長い。ここで定義したBulletml判別共用体は、確かに型付きDSLではあるのですが、BulletMLの仕様に準拠するかたちで型を表現するようにしたのでタイプセーフではないですね。タイプセーフではありませんが、まあそれなりです。今後、より型安全な判別共用体の提供とモナディックな弾幕構築の提供とか、弾幕コンピュテーション式...とかとか妄想しています。あとは、この型を弾幕として解釈することができる処理系を実装すればおｋです(それが面倒くさい）。
牙突 RT @314maro GADTsってどう読むんだろう
— 星のキャミバ様 (@camloeba) 2013, 11月 22というか、俺たちのF#にも牙突ください（！）
外部DSLと内部DSLを両立する
内部DSLであるBulletml判別共用体の構造は再帰的な構造になっていなく複雑です。上図のような構成では外部DSLを解析するためのパーサの実装コストが大きくなってしまいます。そこで、より抽象度の高い中間的なASTを用意し、下図のような構成にすることでパーサの実装コストを軽減することを考えます。
中間ASTとは、つまるところXmlNodeの構造そのものなので、以下のように単純な木構造の判別共用体で表現することができる。
type Attributes = (string * string) list type XmlNode = | Element of string * Attributes * XmlNode list | PCData of string
外部DSLを解析するパーサは、より抽象的で単純な構造にパースするだけでよくなるので、とてもシンプルな実装で済むようになります。実際のパーサの実装例を見てみましょう。
SXML形式のパーサ
かの竹内郁雄氏は、「XMLもぶ厚いカッコのあるLisp」とおっしゃっています。
第1回 Lispの仏さま 竹内郁雄の目力
実際、XML InfosetのS式による具象表現であるところのSXMLがそれを体現していますね。
SXMLの基本的な構成要素はこんな感じです。
[1] <TOP> ::= ( *TOP* <PI>* <Element> ) [2] <Element> ::= ( <name> <attributes-list>? <child-of-element>* ) [3] <attributes-list> ::= ( @ <attribute>* ) [4] <attribute> ::= ( <name> "value"? ) [5] <child-of-element> ::= <Element> | "character data" | <PI> [6] <PI> ::= ( *PI* pi-target "processing instruction content string" )
不勉強なので、Lispとかよくわかりませんが、要素はlist の car。内容は cdr。属性は @ に続く cdr という感じで表現できれば、BulletMLをSXML形式で記述できるようになります。ごくごく簡易的なSXMLのパーサはFParsecを使うと次のような感じに書けます。
namespace FsBulletML open System open System.IO open System.Text open System.Text.RegularExpressions open FParsec open FParsec.Internals open FParsec.Error open FParsec.Primitives open FParsec.CharParsers module Sxml = type SxmlParser<'a> = Parser<'a, unit> type SxmlParser = Parser<XmlNode, unit> let chr c = skipChar c let skipSpaces1 : SxmlParser<unit> = skipMany (spaces1) <?> "no skip" let endBy p sep = many (p .>> sep) let pAst, pAstRef : SxmlParser * SxmlParser ref = createParserForwardedToRef() let parenOpen = skipSpaces1 >>. chr '(' let parenClose = skipSpaces1 >>. chr ')' let parenOpenAt = skipSpaces1 >>. skipString "(@" let pChildOfElement = (sepEndBy pAst skipSpaces1) let betweenParen p = between parenOpen parenClose p let betweenParenAt p = between parenOpenAt parenClose p let pAttr = let pFollowed = followedBy <| manyChars (noneOf "\"() \n\t") let pLabel = manyChars asciiLetter let pVal = skipSpaces1 >>. chr '"' >>. (manyChars (asciiLetter <|> digit <|> noneOf "\"'|*`^><}{][" <|> anyOf "()$+-*/.%:.~_" )) .>> (skipSpaces1 >>. chr '"') skipSpaces1 .>> pFollowed >>. pLabel .>>. pVal let pAttrs = skipSpaces1 >>. sepEndBy (betweenParen pAttr) skipSpaces1 let pBody = skipSpaces1 >>. chr '\"' >>. manyChars (noneOf "\"") .>> chr '\"' let pElement = skipSpaces1 >>. (followedBy <| manyChars (noneOf "\" \t()\n")) >>. pipe4 (manyChars asciiLetter) (attempt (betweenParenAt pAttrs) <|>% [ ]) (attempt pBody <|>% "") (pChildOfElement) (fun name attrs body cdr -> cdr |> function | [ ] when body <> "" -> Element(name, attrs, [PCData(body)]) | [ ] -> Element(name, attrs, [ ]) | cdr -> Element(name, attrs ,cdr)) let ptop = parse { let! car = betweenParen pElement return car } do pAstRef := ptop [<CompiledName "Parse">] let parse input = runParserOnString pAst () "" input [<CompiledName "ParseFromFile">] let parseFromFile sxmlFile = let sr = new StreamReader( (sxmlFile:string), Encoding.GetEncoding("UTF-8") ) let input = sr.ReadToEnd() parse input
このパーサによって、全方位弾の弾幕をこんな感じに記述できるようにます。
(bulletml (action (@ (label "circle")) (repeat (times "$1") (action (fire (direction (@ (type "sequence")) "360/$1") (bullet))))) (action (@ (label "top")) (repeat (times "30") (action (actionRef (@ (label "circle")) (param "20")) (wait "20")))))
スッキリ。ぶ厚いカッコを一掃できて、いい感じですね。
独自形式のパーサについて
「括弧も一掃したいんだが。」という人のためにインデント形式をご用意。インデントで構造化されたデータ表現と言えばYAMLがありますが、YAMLほどの表現力は必要がなくて、弾幕をシンプルに書けさえすればよいので独自形式をでっち上げてみました。
以下のような感じのインデント形式の弾幕も読み込めるパーサも用意してみました。 オフサイドルールな構文をパースしたい場合は、@htid46さんのFParsecで遊ぶ - 2つのアンコールの記事がとても参考になりますね。ソースは省略します。
bulletml action label="circle" repeat times:"$1" action fire direction type="sequence":"360/$1" bullet action label="top" repeat times:"30" action actionRef label="circle" param:"20" wait:"20"
JSON形式のパーサもあってもよいのかも。
Demoプログラムで使った背景画像について
DSL繋がりということで、動画のサンプルプログラムでスクロールさせている背景画像の作成には、DSLで背景画像が作れるF#製のツール「イラスト用背景作成「BgGen」 ver 0.0.0 - ながとのソフト倉庫」を利用させてもらいました。
背景生成に使ったコマンド
rect 0 0 480 680 #f000 circles 1 0 50 #aff
これで宇宙っぽい背景が作れちゃいました。こりゃ便利。
感想
・ F# の判別共用体で型付きDSLをするのは無理ではないけど、段階的にケースが少なくなってどんどん絞り込まれていくような型の場合、それを解釈する処理の実装コストが大きくて結構つらぽよ感溢れました。あまりおすすめできませんね。欲しいです牙突マジ。
・頭の中ではすでに出来ている（作り方がわかっていると思っている）ことと、実際に作ってみることは、やっぱり結構なギャップがあるね。
・ 結果的に行き当たりばったりのゴリ押し実装になってしまったきらいはあるけど、判別共用体で定義した弾幕が思い通りに動いたときはちょっとした達成感が。おじさんちょっと感動しました。
GitHubに晒したソースコード。ツッコミどころ満載なのはある程度は自覚していますが、より良い方法があればアドバイスを。お気づきの点がありましたら @zecl までお願いします。
疲れた！！！でも、ものづくり楽しいし、F# 楽しい✌('ω'✌ )三✌('ω')✌三( ✌'ω')✌
あわせて読みたい
DSL開発：ドメイン駆動設計に基づくドメイン固有言語開発のための７つの提言 - Johan den Haan
言語内 DSL を考える。- togetter
GADTによるHaskellの型付きDSLの構築 - プログラミングの実験場
シューティングゲームを作ったことがある人ならだいたいは勘でわかりますが
VB、C#、F# それぞれのインデクサ。F# コンパイラのソースを読んで。
F# コンパイラのソースを読んで
はぇ〜さん(@haxe) とtwitterにて、以下のようなやり取りがありました。
ところで #fsharp の for m in Regex.Matches(input, pattern) do () はGetEnumerator()をしてくるわりに、m : Match に解決してくれるのはなんでだろう？ 仕組みがわからにあ
2013-06-20 11:03:05 via web
@haxe F# さんがベターな型をよしなに探してくれているからですね。このあたりのソースからたどって全体を見てみると「にやり」とできるかも（！） URL
2013-06-20 11:48:37 via Silverbird M to @haxe
@zecl IEnumerable<T>を実装してないのに、どうやって見つけてるのかな？って話なんです。githubは見てますよん
@haxe 貼っ付けたリンク先のtypecheckerのソースの、"リフレクションでMethInfoを見ている" から"ではなくてですか？
2013-06-20 12:02:53 via Silverbird M to @haxe
@haxe そうだったんですね。見てみてください?
2013-06-20 12:09:49 via Silverbird M to @haxe
@zecl コード読みました。ハードコーディングのグロい実装で成り立ってるんですね?。 Hashtableなんかitemの戻り値Value側がobject型だからそれに解決されるとかかなりやばいｗ URL
2013-06-20 13:02:28 via web to @zecl
@zecl .NET的に正しくはDefaultMemberAttributeを見るべきなんですけどね！ そうすればXmlNodeListもItem()メソッドではなくItemOfプロパティがインデクサだとわかるので。
2013-06-20 13:04:39 via web to @zecl
for m in Regex.Matches(input, pattern) do () で、 MatchCollection から Match に型が解決される件は、わたしがツイートしたとおり。typecheckerのソースを見ればわかるので、まあよし。
問題はその後。
@zecl .NET的に正しくはDefaultMemberAttributeを見るべきなんですけどね！ そうすればXmlNodeListもItem()メソッドではなくItemOfプロパティがインデクサだとわかるので。
2013-06-20 13:04:39 via web to @zecl
@haxe IndexerNameAttributeで別名を付けられることも考慮して...と。確かにそれも一理ありますね。でも、IndexerNameAttributeはそもそも直接利用が推奨されていない属性ですし、インデクサに別名をつけるためのモノではなく、
2013-06-20 14:53:50 via Silverbird M to @haxe
@haxe あくまで他の言語(VB と F#)のインデックス付きプロパティと同等の機能をを提供するためのものにすぎないので。そう考えると、愚直とはいえあの実装でハズしてはいないのかなぁと。
2013-06-20 14:54:13 via Silverbird M to @haxe
@zecl IndexerNameではなくDefaultMemberで。expr.[idx]ではDefaultMemberをちゃんと見てるので "abc".[1] でもCharsプロパティにアクセスできるようです。 URL
2013-06-20 15:10:30 via web to @zecl
@haxe すいませんちゃんと読みきれていませんでした； なるほどです。勝手に整理すると、そもそもインデクサを含む型にDefaultMember属性は指定できないので、C# については考える必要がなかった。XmlNodeListのような型、あるいは
2013-06-20 15:54:45 via Silverbird M to @haxe
@haxe 他の言語(VB と F#)で、Itemという名前ではないプロパティに対して任意の名前がIndexerNameで指定されていて且つ、その任意の名前がDefaultMemberに指定されている場合が考慮されてる実装になっていたんですね。くどくどと失礼しました；
2013-06-20 15:55:01 via Silverbird M to @haxe
@zecl なんか噛み合わないと思ったら。IndexerNameはソースコードのインデクサに付ける属性ですが、コンパイル時に消されます。コンパイル後のアセンブリには、IndexerNameの有無にかかわらずTypeに対してDefaultMemberが自動生成されます。
2013-06-20 16:45:31 via web to @zecl
@haxe ですです。DefaultMemberが自動生成されるときにIndexerNameで指定している場合はその名前が使われるので。それ分の考慮がなされているのだなと。
2013-06-20 16:51:01 via Silverbird M to @haxe
読み返してみると、わたしの発言が支離滅裂なところがあり。そのせいもあって、話が噛み合っていなさすぎてやばい！（はぇ〜さんごめんなさい！）。自分の中ではだいたいわかって納得したような気になっていた・・・のです（ぇ しかし、github の fsharp のソースをまじまじと見ていると、なんだか少しモヤっするものがあったので、改めて F# コンパイラのソースを舐め回すように見てみた。実際にコードも書いて確かめてみた。
すると...、いろいろ間違い（勘違い）をしていたようです（はずかしい）。C# と VBのインデクサの仕様、 C# と F# の仕様はそれぞれ異なるということは把握していたのだが、VB と F# のインデックス付きプロパティ（インデクサ）の挙動に差があることは把握できていませんでした。F# では、DefaultMemberAttribute が自動生成されないケースがあるんです。 ΩΩΩ<な、なんだってー！？
C# のインデクサ と VB のインデクサ
「C# のインデクサ」と 「VB のインデックス付きプロパティ（インデクサ）」については、岩永さんの「インデクサー(C# によるプログラミング入門) - ++C++」を参照で（丸投げ）。
C#のインデクサのサンプル：その１
public class IndexerSample1 { private int[] arr = new int[100]; public int this[int index] { get { if (index < 0 || index >= 100) { return 0; } else { return arr[index]; } } set { if (!(index < 0 || index >= 100)) { arr[index] = value; } } } }
var sample = new IndexerSample1(); var attrs = System.Attribute.GetCustomAttributes(sample.GetType()); // DefaultMemberAttributeが自動生成される Debug.Assert(attrs.Any(x => x.GetType () == typeof(DefaultMemberAttribute))); var attr = attrs.Where(x => x.GetType() == typeof(DefaultMemberAttribute)).Cast<DefaultMemberAttribute>().FirstOrDefault() ; Debug.Assert(attr.MemberName == "Item");
特に細工をすることなくC#でインデクサ付きの型を作ると、"Item"というメンバ名で DefaultMemberAttribute が自動生成される。問題なし。
C#のインデクサのサンプル：その２
public class IndexerSample2 { private int[] arr = new int[100]; [System.Runtime.CompilerServices.IndexerName("SpecialItem")] public int this[int index] { get { if (index < 0 || index >= 100) { return 0; } else { return arr[index]; } } set { if (!(index < 0 || index >= 100)) { arr[index] = value; } } } }
var sample = new IndexerSample2(); var attrs = System.Attribute.GetCustomAttributes(sample.GetType()); // DefaultMemberAttributeが自動生成される Debug.Assert(attrs.Any(x => x.GetType() == typeof(DefaultMemberAttribute))); var attr = attrs.Where(x => x.GetType() == typeof(DefaultMemberAttribute)).Cast<DefaultMemberAttribute>().FirstOrDefault(); // IndexerNameAttributeで指定された名前で生成されている Debug.Assert(attr.MemberName == "SpecialItem");
IndexerNameAttributeで指定した "SpecialItem" というメンバ名で DefaultMemberAttribute が自動生成される。問題なし。
C#のインデクサのサンプル：その３
[System.Reflection.DefaultMember("SpecialItem")] public class IndexerSample3 { private int[] arr = new int[100]; [System.Runtime.CompilerServices.IndexerName("SpecialItem")] public int this[int index] { get { if (index < 0 || index >= 100) { return 0; } else { return arr[index]; } } set { if (!(index < 0 || index >= 100)) { arr[index] = value; } } } }
インデクサ付きの型に対して DefaultMember属性を明示的に指定することはできない。コンパイラに怒られます。
MSDNライブラリ - DefaultMemberAttribute クラス
http://msdn.microsoft.com/ja-jp/library/system.reflection.defaultmemberattribute(v=vs.110).aspx
プロパティは、そのプロパティに引数が存在し、かつ、プロパティ名またはそのいずれかのアクセサーが DefaultMemberAttribute で指定された名前と一致する場合、インデクサー (Visual Basic では既定のインデックス付きプロパティ) としてインポートされます。 格納している型に DefaultMemberAttribute が存在しない場合、その型にはインデクサーは存在しません。 C# コンパイラでは、インデクサーを含むすべての型について、DefaultMemberAttribute を出力します。 C# では、既にインデクサーが宣言されている型に対し、直接 DefaultMemberAttribute で属性を指定するとエラーになります。
MSDNにもそう書いてある。
続いて、VB のインデックス付きプロパティ（インデクサ）について見ていく。
VB のインデックス付きプロパティのサンプル：その１
Public Class IndexerSample4 Private arr As Array = New Integer(100) {} Default Public Property Item(ByVal index As Integer) As String Get If index < 0 OrElse index >= 100 Then Return 0 Else Return arr(index) End If End Get Set(ByVal Value As String) If Not (index < 0 OrElse index >= 100) Then arr(index) = Value End If End Set End Property End Class
var sample = new IndexerSample4(); var attrs = System.Attribute.GetCustomAttributes(sample.GetType()); // DefaultMemberAttributeが自動生成される Debug.Assert(attrs.Any(x => x.GetType() == typeof(DefaultMemberAttribute))); var attr = attrs.Where(x => x.GetType() == typeof(DefaultMemberAttribute)).Cast<DefaultMemberAttribute>().FirstOrDefault(); Debug.Assert(attr.MemberName == "Item");
特に細工をすることなくVBでインデクサ付きの型を作ると、C# と同様に "Item"というメンバ名で DefaultMemberAttribute が自動生成される。問題なし。
VB のインデックス付きプロパティのサンプル：その２
Public Class IndexerSample5 Private arr As Array = New Integer(100) {} <System.Runtime.CompilerServices.IndexerName("SpecialItem")> _ Default Public Property Dummy(ByVal index As Integer) As String Get If index < 0 OrElse index >= 100 Then Return 0 Else Return arr(index) End If End Get Set(ByVal Value As String) If Not (index < 0 OrElse index >= 100) Then arr(index) = Value End If End Set End Property End Class
var sample = new IndexerSample5(); var attrs = System.Attribute.GetCustomAttributes(sample.GetType()); // DefaultMemberAttributeが自動生成される Debug.Assert(attrs.Any(x => x.GetType() == typeof(DefaultMemberAttribute))); var attr = attrs.Where(x => x.GetType() == typeof(DefaultMemberAttribute)).Cast<DefaultMemberAttribute>().FirstOrDefault(); Debug.Assert(attr.MemberName == "Dummy");
DefaultMember属性が暗黙的に生成されるが、IndexerName属性で指定した "SpecialItem" という名前は無視される。実際のプロパティ名(DisplayName)である"Dummy" で作られる。これは知ってた。
VB のインデックス付きプロパティのサンプル：その３
<System.Reflection.DefaultMember("Hoge")> _ Public Class IndexerSample6 Private arr As Array = New Integer(100) {} <System.Runtime.CompilerServices.IndexerName("SpecialItem")> _ Default Public Property Item(ByVal index As Integer) As String Get If index < 0 OrElse index >= 100 Then Return 0 Else Return arr(index) End If End Get Set(ByVal Value As String) If Not (index < 0 OrElse index >= 100) Then arr(index) = Value End If End Set End Property End Class
DefaultMember属性に、インデクサのプロパティ名と異なるメンバ名が指定されると競合が発生する。こんなの初めて書いたｗ
VB のインデックス付きプロパティのサンプル：その４
<System.Reflection.DefaultMember("Item")> _ Public Class IndexerSample7 Private arr As Array = New Integer(100) {} <System.Runtime.CompilerServices.IndexerName("SpecialItem")> _ Default Public Property Item(ByVal index As Integer) As String Get If index < 0 OrElse index >= 100 Then Return 0 Else Return arr(index) End If End Get Set(ByVal Value As String) If Not (index < 0 OrElse index >= 100) Then arr(index) = Value End If End Set End Property End Class
DefaultMember属性に、インデクサのプロパティ名と同様のメンバ名を指定すると問題ない。C# とは異なり、VB ではインデクサ付きの型でDefaultMember属性を明示的に指定することが可能。
var sample = new IndexerSample7(); var attrs = System.Attribute.GetCustomAttributes(sample.GetType()); // DefaultMemberAttributeが指定されているので、当然存在する Debug.Assert(attrs.Any(x => x.GetType() == typeof(DefaultMemberAttribute))); var attr = attrs.Where(x => x.GetType() == typeof(DefaultMemberAttribute)).Cast<DefaultMemberAttribute>().FirstOrDefault(); Debug.Assert(attr.MemberName == "Item");
DefaultMemberAttributeが明示的に指定されているので、当然存在する。メンバ名もそのまんま。ここまでは問題ないです。
F# のインデックス付きプロパティ（インデクサ）
F#のインデックス付きプロパティのサンプル：その１
type IndexerSample8 () = let arr : int [] = Array.zeroCreate 100 member this.Item with get(index) = if index < 0 || index >= 100 then 0 else arr.[index] and set index value = if not (index < 0 || index >= 100) then arr.[index] <- value
var sample = new IndexerSample8(); var attrs = System.Attribute.GetCustomAttributes(sample.GetType()); // DefaultMemberAttributeが自動生成される Debug.Assert(attrs.Any(x => x.GetType() == typeof(DefaultMemberAttribute))); var attr = attrs.Where(x => x.GetType() == typeof(DefaultMemberAttribute)).Cast<DefaultMemberAttribute>().FirstOrDefault(); Debug.Assert(attr.MemberName == "Item");
F#のインデックス付きプロパティのサンプル：その２
type IndexerSample9 () = let arr : int [] = Array.zeroCreate 100 [<System.Runtime.CompilerServices.IndexerName("SpecialItem")>] member this.Item with get(index) = if index < 0 || index >= 100 then 0 else arr.[index] and set index value = if not (index < 0 || index >= 100) then arr.[index] <- value
var sample = new IndexerSample9(); var attrs = System.Attribute.GetCustomAttributes(sample.GetType()); // DefaultMemberAttributeが自動生成される Debug.Assert(attrs.Any(x => x.GetType() == typeof(DefaultMemberAttribute))); var attr = attrs.Where(x => x.GetType() == typeof(DefaultMemberAttribute)).Cast<DefaultMemberAttribute>().FirstOrDefault(); Debug.Assert(attr.MemberName == "Item");
C#と異なり、VBと同じ挙動。知ってた。そりゃそーですよね。
F#のインデックス付きプロパティのサンプル：その３
[<System.Reflection.DefaultMember("Item")>] type IndexerSample10 () = let arr : int [] = Array.zeroCreate 100 [<System.Runtime.CompilerServices.IndexerName("SpecialItem")>] member this.Item with get(index) = if index < 0 || index >= 100 then 0 else arr.[index] and set index value = if not (index < 0 || index >= 100) then arr.[index] <- value
var sample = new IndexerSample10(); var attrs = System.Attribute.GetCustomAttributes(sample.GetType()); // DefaultMemberAttributeが自動生成される Debug.Assert(attrs.Any(x => x.GetType() == typeof(DefaultMemberAttribute))); var attr = attrs.Where(x => x.GetType() == typeof(DefaultMemberAttribute)).Cast<DefaultMemberAttribute>().FirstOrDefault(); Debug.Assert(attr.MemberName == "Item");
VBと同じように、明示的にDefaultMember属性を指定することができる。
F#のインデックス付きプロパティのサンプル：その４
[<System.Reflection.DefaultMember("Hoge")>] type IndexerSample11 () = let arr : int [] = Array.zeroCreate 100 [<System.Runtime.CompilerServices.IndexerName("SpecialItem")>] member this.Item with get(index) = if index < 0 || index >= 100 then 0 else arr.[index] and set index value = if not (index < 0 || index >= 100) then arr.[index] <- value
VBと同じように、競合が発生してエラーとなるかと思いきや・・・、コンパイルが通る！！！
var sample = new IndexerSample11(); var attrs = System.Attribute.GetCustomAttributes(sample.GetType()); // DefaultMemberAttributeが自動生成される Debug.Assert(attrs.Any(x => x.GetType() == typeof(DefaultMemberAttribute))); var attr = attrs.Where(x => x.GetType() == typeof(DefaultMemberAttribute)).Cast<DefaultMemberAttribute>().FirstOrDefault(); Debug.Assert(attr.MemberName == "Item");
DefaultMember属性のメンバ名に誤った名称が指定されている場合、それは無視される。実プロパティ名をメンバ名として DefaultMember属性 が自動生成される。これは予想外の動き！！！
しかし、この場合
let sample = new IndexerSample11() let v = sample.[0]
なぜか、DefaultMember属性のメンバ名が"Hoge"だって言われる。なので、インデクサにアクセスできない。ど、どういうことだってばよ！？
確認のためのソースが悪かったorz
var sample = new IndexerSample11(); var attrs = System.Attribute.GetCustomAttributes(sample.GetType()); // DefaultMemberAttributeが自動生成される Debug.Assert(attrs.Any(x => x.GetType() == typeof(DefaultMemberAttribute))); var attrs2 = attrs.Where(x => x.GetType() == typeof(DefaultMemberAttribute)).Cast<DefaultMemberAttribute>(); Debug.Assert(attrs2.Any( x => x.MemberName == "Hoge"));
DefaultMember属性が暗黙的に生成されているんだけど、明示的に指定したやつとだぶっちゃっている。あらまあ。
ってかこれ、バグっぽいちゃーバグっぽいゼ！？
F#のインデックス付きプロパティのサンプル：その５
type IndexerSample12 () = let arr : int [] = Array.zeroCreate 100 [<System.Runtime.CompilerServices.IndexerName("SpecialItem")>] member this.Dummy with get(index) = if index < 0 || index >= 100 then 0 else arr.[index] and set index value = if not (index < 0 || index >= 100) then arr.[index] <- value
var sample = new IndexerSample12(); var attrs = System.Attribute.GetCustomAttributes(sample.GetType()); // DefaultMemberAttributeが自動生成されない Debug.Assert(!attrs.Any(x => x.GetType() == typeof(DefaultMemberAttribute))); var attr = attrs.Where(x => x.GetType() == typeof(DefaultMemberAttribute)).Cast<DefaultMemberAttribute>().FirstOrDefault(); Debug.Assert(attr == null);
IndexerSample5のように、VBと同じ挙動をするかと思いきや、なんと、DefaultMemberAttributeが自動生成されないケースがここで発生。これは、F#のインデクサ付き型で、DefaultMemberAttributeが自動生成されないケースが存在すると言うよりも、「F# は、VB とは挙動が異なり、任意の名称のプロパティではでインデクサ付きの型とはならない」と言うのが正しいだろう。なんということでしょう。F# コンパイラによって「DefaultMemberAttributeが自動生成されない」ケースがあった！！！これは知らなかった。意図的なのかどうなのかわからないが、C#、VB いずれとも異なる挙動になるように作られている。
ってかこれ、バグっぽいちゃーバグっぽいゼ！？
F# でインデクサにアクセスすることができない。当然、こうなります。
F# コンパイラのソースを見てみようのコーナー
では、コンパイラの中で一体何が起こっているんでしょう。ソースを見てみる。
IL的に DefaultMemberAttribute を自動生成しているらしいこのあたりを引用する。
https://github.com/fsharp/fsharp/blob/master/src/fsharp/ilxgen.fs#L6239
let defaultMemberAttrs =
// REVIEW: this should be based off tcaug_adhoc_list, which is in declaration order
tycon.MembersOfFSharpTyconSorted
|> List.tryPick (fun vref ->
let name = vref.DisplayName
match vref.MemberInfo with
| None -> None
| Some memberInfo ->
match name, memberInfo.MemberFlags.MemberKind with
| ("Item" | "op_IndexedLookup"), (MemberKind.PropertyGet | MemberKind.PropertySet) when nonNil (ArgInfosOfPropertyVal cenv.g vref.Deref) ->
Some( mkILCustomAttribute cenv.g.ilg (mkILTyRef (cenv.g.ilg.mscorlibScopeRef,"System.Reflection.DefaultMemberAttribute"),[cenv.g.ilg.typ_String],[ILAttribElem.String(Some(name))],[]) )
| _ -> None)
|> Option.toList
「// REVIEW: this should be based off tcaug_adhoc_list, which is in declaration order」のコメントも気になっちゃいますが、それは置いていおいて・・・。ここを起点に全体のソースを舐め回すように眺めてみる。ふむふむなるほど。F# コンパイラさん、IndexerName 属性はまったく見ていないご様子。そして、「let name = vref.DisplayName」を見ればわかるように、実プロパティ名を参照している。そして、実プロパティ名が、"Item" 、"op_IndexedLookup"のいずれかの場合に限り、実プロパティ名を使って DefaultMemberAttribute が暗黙的に生成されていることがわかります。
では、DisplayNameが "op_IndexedLookup"であるとき、とはどんな時か。次のサンプルのようなケースのときである。
F#のインデックス付きプロパティのサンプル：その６
[<System.Reflection.DefaultMember("Hoge")>] type IndexerSample13 () = let arr : int [] = Array.zeroCreate 100 [<System.Runtime.CompilerServices.IndexerName("Fuga")>] member this.Hoge with get(index) = if index < 0 || index >= 100 then 0 else arr.[index] and set index value = if not (index < 0 || index >= 100) then arr.[index] <- value
var sample = new IndexerSample13(); var attrs = System.Attribute.GetCustomAttributes(sample.GetType()); // DefaultMemberAttributeが自動生成される Debug.Assert(attrs.Any(x => x.GetType() == typeof(DefaultMemberAttribute))); var attrs2 = attrs.Where(x => x.GetType() == typeof(DefaultMemberAttribute)).Cast<DefaultMemberAttribute>(); Debug.Assert(attrs2.Any( x => x.MemberName == "Hoge"));
DefaultMemberAttributeはダブっていない。もちろんIndexerName属性も華麗にスルーです。
当然、インデクサにF#からアクセスできる。
自分のためのまとめ
・F# コンパイラは、DefaultMember属性を暗黙的に生成するとき、C#とは異なり、IndexerName属性は華麗にスルーされる。VBと同じ。
・F#のインデックス付きプロパティと、VBのインデックス付きプロパティは違う。思い込みイクナイ。
・F# コンパイラは、インデックス付きプロパティがあっても DefaultMember 属性を暗黙的に生成しない場合がある（てゆーか、それインデクサ付きの型じゃないですしおすし）。
・VB、C#、F# は、それぞれインデクサの仕様が異なるので気をつけましょう。
・ってかこれ、バグっぽいちゃーバグっぽいゼ！？(DefaultMember属性のダブりとかマジやべぇ)*1
気まぐれでサラッとだけ書くつもりだったのに。なんやかんやで無駄に長くなって疲れた（内容しょぼいのに！）。
お疲れ様でした。
*1:まぁ、ふつーにインデクサを使うだけなら問題にならないので、「仕様です」っちゃー仕様ですね
クリップボードの文字列を、「突然の死」テンプレートに置き換えるやつ
元ネタ
「突然の死」をTwitterへ簡単に送り出せる「突然の死ジェネレータ」 - GIGAZINE
http://gigazine.net/news/20120703-suddenly-death/
突然の死ジェネレータ
クリップボードの文字列を、「突然の死」テンプレートに置き換えます（マルチライン対応）。
Totsuzen.fs
open System open System.Text open System.Windows.Forms let rc = "\r\n" let length s = Encoding.GetEncoding(932).GetByteCount(s:string) |> fun len -> if len % 2 = 1 then (len + 1) / 2 else len / 2 let split (separator:string) (text:string) = text.Split([|separator|], StringSplitOptions.None) let repeat s i = [1..i] |> Seq.map (fun _ -> s) |> Seq.fold (+) "" let width f lines = lines |> Seq.map(fun s -> f s) |> Seq.max let centerAlign lines = let f line = let len = length line let lw, rw, pad = let maxw = width length lines let lw = (maxw - len) / 2 lw, maxw - lw - len, repeat " " pad lw + line + pad rw lines |> Seq.map f let border lines = let header = "＿" + repeat "人" (width length lines + 2) + "＿" let footer = "￣" + repeat "Y^" (width length lines) + "Y￣" let side lines = let f line = "＞ " + line + " ＜" + rc Seq.map f lines |> Seq.reduce (+) header + rc + (centerAlign lines |> side) + footer [<STAThread>] [<EntryPoint>] let main args = let (!) = function | "" -> "突然の死" | s -> s !Clipboard.GetText() |> split rc |> border |> Clipboard.SetText 0
＿人人人人人人人人人人人人＿ ＞ 暇つぶしにちょっと ＜ ＞ やってみたかっただけ ＜ ￣Y^Y^Y^Y^Y^Y^Y^Y^Y^Y^Y￣
とてもゴガツビョウです＼(^o^)／
マルコフ連鎖とビタビアルゴリズム(HMM)を F# で。
元ネタ
昼食時に店で流れていた、大事MANブラザーズバンド「それが大事」の歌詞が、あまりに繰り返しばかりなので、状態遷移図を作りました。どうぞご利用下さい。
http://youkoseki.com/soregadaiji/
「それが大事」にマルコフ連鎖を適用してみる
https://www.evernote.com/shard/s70/sh/71947f67-ee6c-405f-92a2-1d64fd631639/2d9397138827808cbc21c36c9389f642
マルコフ連鎖で「それが大事」っぽい歌詞を自動生成する
http://vilart.sakura.ne.jp/daijiman.html
自動生成された文字列が違和感なく連鎖するのがいいね！ネタのチョイスが面白くってちょっと書いてみたくなった。大事MANブラザーズバンドの大ヒット曲「それが大事」っぽい歌詞をマルコフ連鎖で自動生成。これを F# でやってみる。形態素解析には .NET で MeCabが簡単に使えるNMeCabを利用させてもらう。
open System open System.Collections.Generic open NMeCab open Microsoft.FSharp open Microsoft.FSharp.Core let tagger = MeCabTagger.Create () let parse format s = tagger.OutPutFormatType <- format tagger.Parse s let src = @"負けない事・投げ出さない事・逃げ出さない事・信じ抜く事 駄目になりそうな時 それが一番大事 負けない事・投げ出さない事・逃げ出さない事・信じ抜く事 涙見せてもいいよ それを忘れなければ Oh 高価な墓石を建てるより 安くても生きてる方がすばらしい ここにいるだけで 傷ついてる人はいるけど さんざん我侭言った後 あなたへの想いは 変わらないけど 見えてるやさしさに 時折負けそうになる ここにあなたがいないのが 淋しいのじゃなくて ここにあなたがいないと思う事が淋しい(でも) 負けない事・投げ出さない事・逃げ出さない事・信じ抜く事 駄目になりそうな時 それが一番大事 高価なニットをあげるより 下手でも手で編んだ方が美しい ここに無いものを 信じれるかどうかにある 今は遠くに離れてる それでも生きていれば いつかは逢える でも傷つかぬように 嘘は繰り返される ここにあなたがいないのが せつないのじゃなくて ここにあなたがいないと思う事がせつない でも 負けない事・投げ出さない事・逃げ出さない事・信じ抜く事 駄目になりそうな時 それが一番大事 負けない事・投げ出さない事・逃げ出さない事・信じ抜く事 駄目になりそうな時 それが一番大事 負けない事・投げ出さない事・逃げ出さない事・信じ抜く事 涙見せてもいいよ それを忘れなければ 負けない事・投げ出さない事・逃げ出さない事・信じ抜く事 駄目になりそうな時 それが一番大事 負けない事・投げ出さない事・逃げ出さない事・信じ抜く事 涙見せてもいいよ それを忘れなければ" // NMeCabで分かち書き let wakati s = if s = "" then [||] else let split separators x = (x:string).Split(separators) let wk = parse "wakati" s split [|' '|] wk |> Array.toList |> List.toArray // N階マルコフ let markov n source = let model = new Dictionary<_,_> () let add k (v:string) = if not <| model.ContainsKey k then model.Add(k,[]) model.[k] <- model.[k]@[v] let mutable p = Array.create n "" |> Array.toList for next in source do add (p) next p <- (List.tail p) @[next] let s = (List.tail p) |> List.reduce (fun x y -> x + y) let lst = (s).Replace("\r", "").Replace("\n", "") add (p@[lst]) null model // N階マルコフ連鎖で文章生成 let generateMarkovChain n first source = let random = new Random () let model = markov n source let keyValuePairs = (model.Keys :> seq<_>) let generate p = let sentence = fun p -> if model.ContainsKey(p) then let candidate = model.[p] let next = candidate.[random.Next (candidate.Length)] Some (next,(List.tail p)@[next]) else None Seq.unfold sentence p |> Seq.fold (fun a b -> a + b) "" first (keyValuePairs) |> generate wakati src |> generateMarkovChain 2 (fun keys -> keys |> Seq.head) |> fun s -> s.Replace ("\r","\r\n") |> printfn "%s" Console.ReadKey () |> ignore
元ネタと同じことができた。人工無能や twitter の bot を作る時なんかのたたき台くらいにはなりそう。やる予定ぜんぜんないけど。これといって見どころはありませんが、しいて言うなら単純マルコフ過程固定ではなく、N 階マルコフ過程な連鎖を表す関数にしてるところくらいでしょうか。で、好奇心がわいてきたのでなんとなーく関連情報をいろいろ漁っていく。すると、「マルコフ連鎖モンテカルロ法」、「隠れマルコフモデル」、「ビタビアルゴリズム」、「バウム・ウェルチアルゴリズム」などなどいろいろと面白そうなキーワードが出てくる。
マルコフ連鎖モンテカルロ法については、テラモナギさん(@teramonagi) のスライドがとても面白かった。
マルコフ連鎖モンテカルロ法入門−1
http://d.hatena.ne.jp/teramonagi/20100913/1284387360
マルコフ連鎖モンテカルロ法入門−２
http://d.hatena.ne.jp/teramonagi/20101003/1286079803
統計や機械学習については完全に門外漢であるし、いろいろとわからないことだらけの私だが。面白いものは面白い。
隠れマルコフモデルとビタビアルゴリズム
字が汚くて「尤度」って書こうとしても「犬度」になってしまう件。
2013-04-06 11:06:12 via web
@kos59125 どんな度合いなんだろう…
2013-04-06 11:30:14 via Janetter to @kos59125
@finalfusion わかりませんが対義語はおそらく猫度でしょう。
2013-04-06 11:31:32 via web to @finalfusion
@kos59125 なるほど
2013-04-06 11:37:30 via Janetter to @kos59125
尤度よりも犬度が。犬度よりも猫度が気になる今日このごろ。
遠くに住んでいる友達が、毎日何をしたかを電話で教えてくれます。友達は「散歩」、「買物」、「掃除」の３つのことにしか関心がありません。友達が住んでいるところの天気の明確な情報は持っていないが、友達が何をするかはその日の天気で決める傾向があることは知っている。たとえば「雨」だったら５０％の確率で「掃除」をするとか、「晴れ」だったら６０％の確率で「散歩」をするなどです。また、天気の状態は「雨」、「晴れ」のいずれかで、たとえば今日が雨だったら明日が晴れの確率は３０％、雨の確率は７０％という具合に、天気は離散マルコフ連鎖に従うとします。このとき、天気の状態は友達がする行動に隠れている(hidden)と見なすことができる。友達はその日の天気に従って「散歩」、「買い物」、「掃除」のいずれか１つだけ行動をとって教えてくれるので、これらは観測(observations)できる対象と見なせる。このとき、これは隠れマルコフモデル (HMM：Hidden Markov Model) 的である、と言う。
天気の傾向と、友達はどのような行動をとるかという傾向を知っているとき。言い換えると、隠れマルコフモデルのパラメータについて知っているということを意味していて、たとえば、友達が初日に散歩をして、２日目に買い物を。３日目に掃除を、というような順番に行動とったとき、その観測結果が得られる確率はいくらか？そして、このような観測結果がえられたとき３日間（とその翌日）の天気はどのようであったか？ということを予測したい。前者は前向きアルゴリズムを。後者はビタビアルゴリズム*1を用いることで求めることができる。
という内容の隠れマルコフモデルの例（コードはPython）がWikipediaに出ている。
隠れマルコフモデル - Wikipedia
http://goo.gl/oDu5k
ビタビアルゴリズム - Wikipedia
http://goo.gl/tbpnO
これを F# で書いてみる。
Program.fs
open HMM // 状態（ラベル）：雨 | 晴れ type States = Rainy | Sunny // 観測されたもの：散歩 | 買い物 | 掃除 type Observations = Walk | Shop | Clean // 初期確率 let startingProbs = [Rainy, 0.6; Sunny, 0.4] |> Map.ofList // 状態（ラベル）の遷移確率 let transitionProbs = [(Rainy,Rainy), 0.7; (Rainy,Sunny), 0.3 (Sunny,Rainy), 0.4; (Sunny,Sunny), 0.6] |> Map.ofSeq // それぞれの観測された行動に対する、状態（ラベル）の出力確率 let emissionProbs = [(Rainy, Walk), 0.1; (Rainy, Shop), 0.4; (Rainy, Clean), 0.5 (Sunny, Walk), 0.6; (Sunny, Shop), 0.3; (Sunny, Clean), 0.1] |> Map.ofSeq // 開始確率を取得します。 let startProbability s = startingProbs.[s] // 遷移確率を取得します。 let transitionProbability spair = transitionProbs.[spair] // 出力確率を取得します。 let emissionProbability sopair = emissionProbs.[sopair] let obs = [Walk; Shop; Clean] let states = [Rainy;Sunny] let viterbi = Viterbi(obs, states, startProbability, transitionProbability, emissionProbability) assert (viterbi.TotalProb = 0.0336) viterbi.TotalProb |> printfn "%A" assert (viterbi.ViterbiPath = [Sunny;Rainy;Rainy;Rainy]) viterbi.ViterbiPath |> printfn "%A" assert (viterbi.ViterbiProb = 0.009408) printfn "%A" viterbi.ViterbiProb
Viterbi.fs
namespace HMM open System type dict<'a, 'b> = Collections.Generic.Dictionary<'a,'b> [<AutoOpen>] module HMM = type Viterbi<'o,'s when 's:equality> ( obs : seq<'o>, states : seq<'s>, sp : 's -> float, tp : 's * 's -> float, ep : 's * 'o -> float) as this = let mutable last = dict<'s, float * float>() let mutable current = [dict<'s, float * float>()] let viterbiPath = dict<'s,'s list>() let initialize (o,states) = for state in states do last.[state] <- ((sp state), (sp state) * ep(state,o)) viterbiPath.[state] <- [state] current <- [last] let nextState f states = let next = dict<'s, float * float>() let add = fun (target, state, cp, prob) -> next.[target] <- (cp, prob) viterbiPath.[target] <- target::viterbiPath.[state] let junction = fun target -> states |> Seq.map (fun state -> let _,sp = last.[state] let cp, prob = f state target sp target,state, cp, prob) |> Seq.maxBy (fun (_,_,_,prob) -> prob) states |> Seq.map (junction) |> Seq.iter(add) last <- next current <- next::current let lastViterbiState () = current.Head |> Seq.maxBy (fun kv -> kv.Value) do this.Execute (obs, states) /// ビタビ経路の最後の状態 member x.LastViterbiState = lastViterbiState () /// 実行 member private x.Execute(obs, states) = let f = fun o state target sp -> let cp = ep(target, o) cp, sp * cp * tp(state, target) for i,o in (obs |> Seq.mapi (fun i x -> i,x)) do if i = 0 then initialize (o, states) else nextState (f o) states let g = fun state target sp -> let lastViterbiState = x.LastViterbiState let cp = tp(lastViterbiState.Key, target) cp, sp * cp // 与えられたパラメータから推察される次の状態 nextState g states /// 与えられたパラメータに対する全体確率 member x.TotalProb = x.ViterbiPathProb () |> List.mapi (fun i (state,(ep,vp)) -> if i = 0 then vp else ep) |> Seq.reduce (fun x y -> x * y) member private x.ViterbiPathProb () = let lastViterbiState = x.LastViterbiState viterbiPath.[lastViterbiState.Key] |> List.mapi (fun i state -> state,current.[i].[state] ) |> List.rev /// ビタビ経路(最も尤もらしい並び。尤度が最も高い経路。)を取得します。 member x.ViterbiPath = x.ViterbiPathProb () |> List.map (fun (state,(ep,vp)) -> state) /// ビタビ経路の確率 member x.ViterbiProb = let lastViterbiState = x.LastViterbiState let _,vp = current.Head.[lastViterbiState.Key] vp member x.Path = current
実行結果
0.0336 [Sunny; Rainy; Rainy; Rainy] 0.009408
F#で書いてみましたというだけで、特に面白みはない。
実行結果を見る限りは多分あっているぽい。けど、門外漢が適当に勘で書いたものなので鵜呑みはせぬようよろしくオナシャス。
*1:観測された事象系列を結果として生じる隠された状態の最も尤もらしい並びをビタビ経路と呼ぶ
ステップアップでわかるコンピュテーション式。TryWith や TryFinally などの実装にぜひ活用したい Delayと Run
全国１億２千万人の F# ファンの皆様いかがお過ごしでしょうか。理解できるわけもないとわかっていながらも調子に乗って「型システム入門 プログラミング言語と型の理論」を買ってしまった系の痛いおじさんです。１０年後、２０年後にわかることができてたらいいなくらいのノリで読んでいます。が、早くも挫折の兆しです。歩道の雪はまだまだ残ってるながらも極寒の地もようやく春めいてきました。最近やけに眠いです。春眠暁をなんとやら。プライベートな時間に勉強をするモチベーションがあまりないので、最近は映画観たりゲームばっかりやっています（下り坂）。
読む・・・！読むが・・・今回まだその時と理解度の指定まではしていない。そのことをどうか諸君らも思い出していただきたい つまり・・・我々がその気になれば理解は１０年後、２０年後ということも可能だろう・・・ということ・・・！
自分が理解していることについてちょっと書いてみたい
わたしの誤字ツイートがかなり恥ずかしい感じですが、こんなやり取りがありました。
@igeta Mr.えふしゃーぷサマサマですね。ところで、Stateモナ..コンピューテーション式の記事はかどってますか
2013-03-29 15:52:32 via Silver Bird Plus to @igeta
@zecl 書くかどうか、というか書けるかどうかわかりませんが、書くんだったらコンピュテーション式のモッナード側面全般の記事にしたいっすね。
@zecl DelayとRunを使ったほうが楽になる理由ってなんでしょうか？利点があればぜひ知りたいです。
2013-03-29 20:58:15 via HootSuite to @zecl
F# 専用の DBアクセスライブラリ「Tranq」を開発なさっている、ナイス F#er のなかむらさん(@nakamura_to)にリアクションを頂いたので、ある程度の前提知識がある方向け（？）にちょっと書いてみます。ガブさん(@gab_km)の「できる！コンピュテーション式」あたりを理解していることが望ましいです。モナド的なお話はあまりありません。モッナード側面のお話はいげ太さん(@igeta)がしてくれるらしい（？）
Delay と Run を使ったほうがなぜ楽になるのか。その答えは「なぜ Delayメソッドがコンピュテーション式の基本メソッドとして提供されているのか。」の理由を紐解くとおのずと見えてきます。結論から言うと、「{| try cexpr with | pattern_i -> expr_i |}」の cexpr の部分などは、コンピュテーション式そのものが評価された後で評価されて欲しいからです。その答えはF#の言語仕様およびコンパイラのソースコードの中にあります。Delay には、他のメソッドとは少し違う特徴があります。この記事では Maybeモナドを例に、コンピュテーション式が標準でサポートする各メソッドはなんのために用意されているのか？ その明確な意味について、順を追ってゆる〜く見て行きたいと思います。「ステップアップでわかるコンピュテーション式」的な何かです。
Step1 : 背景にモナドを持つ Bind と Return メソッド
Bind と Return メソッド、その背景にはモナドがあります。
ですが、"モナドとはまったく関係なく自由に利用することができるメソッドである" ということをあらかじめ申し上げておきます。
くどいと思われる方は読みとばしていただいて結構です。Delay と TryWith 関連の詳細な話題は Step5 以降で扱っています。
Step2 : 一手間を省く ReturnFromメソッド
Step3 : コンピュテーション式の流れをコントロールする Delay と Combineメソッド
Step4 : 「if式のelseを省略したい！」 Zeroメソッド
Step5 : 「try...with 式を使いたい！」 TryWithメソッド
Step6 : 「{| try cexpr with | pattern_i -> expr_i |}」の cexpr の評価を遅延する
Step7 : 最終的なコンピュテーション式の型を決定する Runメソッド
Step8 : 「try...finaly式を使いたい！」TryFinallyメソッド
寄り道 : F#3.0のコンパイラのソースコードを読もう
Step9 : 「use 束縛を使いたい！」Usingメソッド
Step10 : 「while...do式を使いたい！」Whileメソッド
Step11 : 「for...do式を使いたい！」Forメソッド
コンピュテーション式で Maybeモナド を表現すると、以下のようになります。
type MaybeBuilder() = member b.Bind(m, f) = Option.bind f m member b.Return(a) = Some a let maybe = new MaybeBuilder()
いわゆる「ビルダークラス」と呼ばれるクラスを定義し、そのインスタンスを使ってコンピュテーション式として使えるようにしたものです。たとえば以下のように Maybe の文脈の計算を簡単に、しかも読みやすく書くことができるようになります。
maybe { let! a = Some 15 let! b = Some 20 return a + b } |> printfn "%A" // Some 35 maybe { let! a = Some "F#!" return a + a } |> printfn "%A" // Some "F#!F#!"
Bindメソッドは、コンピュテーション式の let! および do! に対して呼び出されるものです。let! キーワードで値を束縛して次の計算に渡したり、do! キーワードで処理を行えるようになります。Returnメソッドは、コンピュテーション式の return に対して呼び出されるものです。Maybeモナド のようにコンテナ（ここではOption型）を扱うような場合、いわゆるコンテナに値を包むような操作を定義します*1。Bindメソッドは、Haskellの Monad の(>>=)演算子に。Returnメソッドは、Haskellの Monad の return に対応するように意識されて用意されたものです。
class Monad m where (>>=) :: m a -> (a -> m b) -> m b return :: a -> m a
コンピュテーション式 (F#) - MSDNライブラリのページでは、Bind と Retrun のシグネチャは以下のように示されています。
http://msdn.microsoft.com/ja-jp/library/vstudio/dd233182.aspx
引数と対応付けて書くと、こうですね。
builder.Bind(m:M<'T>, f:('T -> M<'U>)) : M<'U> builder.Return(a:'T) : M<'T>
もちろんMaybeBuilderはこのシグネチャにそっています。
type MaybeBuilder() =
member b.Bind(m:option<'a>, f:('a -> option<'b>)) : option<'b> = Option.bind f m
member b..Return(a:'a) : option<'a> = Some a
F# には Haskellでいう型クラスはありません。ですから、Haskell の m a と F# の M<'T> はまったく同じものを意味するわけではありませんが、
コンピュテーション式が提供された背景として、Haskell の Monad があることがわかります。
コンピュテーション式は、モナドを表現するのにとても都合がいいように設計されています。でも実際には、Bind や Return などのコンピュテーション式で利用可能な各メソッドのシグネチャにそのような制約はありません。ビルダークラスの各メソッドの定義には、引数の数のみが制限されます。なので、わりかし自由度の高い計算の構築ができるようになっています。制限がゆるいおかげでいろいろ好き勝手ができます。コンピュテーション式はモナドだけのための構文ではないのです。
type HogeBuilder() = member b.Return(a:int->int) : int -> int = a member b.Bind(m:int -> int, f: (int -> int)-> (int -> int)) = f m let hoge = new HogeBuilder() hoge { let! a = fun x -> 5 + x let! b = fun x -> 20 - x return a >> b } |> fun f-> f 0 |> printfn "%A" // 15
自由とはときとして不自由である。という話もあります。
Step2 : 一手間を省く ReturnFromメソッド
ReturnFrom は定義をしなくても別段困ることはありませんが、あると便利です。
type MaybeBuilder() = member b.Bind(m, f) = Option.bind f m member b.Return(a) = Some a // add member b.ReturnFrom(m) = m let maybe = new MaybeBuilder()
maybe { return! None } |> printfn "%A" // <null> ※None maybe { let! a = Some "F# is fun!" return a } |> printfn "%A" // Some "F# is fun!" maybe { return! Some "F# is fun!" } |> printfn "%A" // Some "F# is fun!"
一度 Bind (!let)で受けてから、Return(return)をするという手間を省くことができるようになります。
コンピュテーション式をより書きやすくするためにあるもの。という位置づけのものと考えて差し支えないでしょう。
Step3 : コンピュテーション式の流れをコントロールする Delay と Combineメソッド
コンピュテーション式で、「if式を使いたい！」というモチベーションが発生したら、Combineメソッドを実装しましょう。
コンピュテーション式の式の流れをコントロールしたい場合は、Combineメソッドを実装しましょう。その名の意味のとおり、計算式を結合するためのものです。
※コメントでNobuhisaさん(@nobuhisa_k)からツッコミをいただきました。ありがとうございます！
修正前、Combineメソッドを実装していないと、コンピュテーション式の中で if式そのものが利用できないという誤解を与える記述がありましたが、それは誤りです。
if式をただ使うだけであれば、Combineメソッドを実装する必要はありません。以下のように利用することができます。
type MaybeBuilder() = member b.Bind(m, f) = Option.bind f m member b.Return(a) = Some a member b.ReturnFrom(m) = m let maybe = new MaybeBuilder()
maybe { let! c = Some "C#" let! fs = Some "F#" let! vb = Some "VB" let! cpp = Some "C++" if (fs > vb) && (vb > c) then return vb elif c > vb then return c else return fs} |> printfn "%A" // Some "F#"
しかし、if式の後にも式を続けて記述したい場合はどうでしょう？
if 式だけで式の流れが完結している場合は問題ありませんが、コンピュテーション式の中で式の流れの制御が必要になった場合、Combineメソッドの実装が必要となります。
これは if式の利用に限ったことではなく、極端な話、以下のような記述をするためには Combineメソッドを実装する必要があります。
type MaybeBuilder() = member b.Bind(m, f) = Option.bind f m member b.Return(a) = Some a member b.ReturnFrom(m) = m // add member b.Combine(x, y) = x |> ignore; y let maybe = new MaybeBuilder()
これは一体どういうことえだってばよ！？
F#3.0の言語仕様によると、Combineはコンパイラによって以下のように展開されるので、Delayが必須だということですね。
T(ce1; ce2, V, C, q) = C(b.Combine({| ce1 |}0, b.Delay(fun () -> {| ce2 |}0)))
6.3.10Computation Expressions - The F# 3.0 Language Specification
http://research.microsoft.com/en-us/um/cambridge/projects/fsharp/manual/spec.html#_Toc335818835
type MaybeBuilder() = member b.Bind(m, f) = Option.bind f m member b.Return(a) = Some a member b.ReturnFrom(m) = m member b.Combine(x, y) = x |> ignore; y // add member b.Delay (f) = f() let maybe = new MaybeBuilder()
maybe { let! c = Some "C#" let! fs = Some "F#" let! vb = Some "VB" let! cpp = Some "C++" if (fs > vb) && (vb > c) then return vb elif c > vb then return c else return cpp return fs } |> printfn "%A" // Some "F#" maybe { let! c = Some "C#" let! fs = Some "F#" let! vb = Some "VB" let! cpp = Some "C++" return c return vb return cpp return fs} |> printfn "%A" // Some "F#"
コンピュテーション式の計算式の流れは、上から下へ（左から右へ）流れています、その流れを制御するのが Combineメソッドです。Combineメソッドは、Haskell の MonadPlus の mplus にあたるものとして解釈される場合もありますが、コンピュテーション式の中の式の流れを制御するためのものと理解するとよいでしょう。
Step4 : 「if式のelseを省略したい！」 Zeroメソッド
コンピュテーション式で、「if式のelse以下を省略したい！」というモチベーションが発生したら、Zeroメソッドを実装しましょう。
type MaybeBuilder() = member b.Bind(m, f) = Option.bind f m member b.Return(a) = Some a member b.ReturnFrom(m) = m member b.Combine(x, y) = x |> ignore; y member b.Delay (f) = f() // add member b.Zero() = None let maybe = new MaybeBuilder()
maybe { if false then return "F#" } |> printfn "%A" // <null> ※None maybe { if true then return "F#" } |> printfn "%A" // Some "F#"
コンピュテーション式の計算式の流れのなかで式が省略されたとき、None が流れていることがわかります。Zeroメソッドは、Haskell の MonadPlus の mzero の意味として解釈される場合もありますが、コンピュテーション式においては、上（左）の計算式が省略された場合に利用される既定値を表すものと理解するとよいでしょう。
Step5 : 「try...with 式を使いたい！」 TryWithメソッド
コンピュテーション式で、「try...with 式を使いたい！」というモチベーションが発生したら、TryWithメソッドを実装しましょう。
type MaybeBuilder() = member b.Bind(m, f) = Option.bind f m member b.Return(a) = Some a member b.ReturnFrom(m) = m member b.Combine(x, y) = x |> ignore; y member b.Delay(f) = f() member b.Zero() = None // add member b.TryWith (m, hander) = try m with ex -> hander ex let maybe = new MaybeBuilder()
maybe { let! x = None try return x / 0 with | e -> return 0 } |> printfn "%A" // <null> ※None maybe { let! x = Some 10 try return x / 0 with | ex -> printf "%s" ex.Message return 0 } |> printfn "%A" // 例外が発生するがキャッチできない
「0 で除算しようとしました。Some 0」 と出力されてされて欲しいところですが、コンピュテーション式そのものの評価がされる前に、0除算が先に評価されてしまっている。Delay、TryWith いずれのメソッドのシグネチャも、MSDN に書いてある通りに実装したのに、この有様です。それもそのはず。「member b.Delay(f:unit-> option<'a>) = f() 」を見れば明らか。そもそも Delay されていた処理を、即時評価してしまっているのですから、こうなります。
builder { cexpr } は、どのように展開されるか？ これについては、本家の F#3.0 の言語仕様を参照しましょう。
6.3.10Computation Expressions - The F# 3.0 Language Specification
http://research.microsoft.com/en-us/um/cambridge/projects/fsharp/manual/spec.html#_Toc335818835
Combineメソッドのときもそうでしたが、コンピュテーション式がコンパイラによって変換されたときに、自動的に Delay メソッドが挿入されるタイミングが他にもいくつかある。それが以下のとおり、
T(e, V, C, q) where e : the computation expression being translated
V : a set of scoped variables
C : continuation (or context where “e” occurs,
up to a hole to be filled by the result of translating “e”)
q : Boolean that indicates whether a custom operator is allowed
T(while e do ce, V, C, q) = T(ce, V, lv.C(b.While(fun () -> e, b.Delay(fun () -> v))), q)
T(try ce with pi -> cei, V, C, q) =
Assert(not q); C(b.TryWith(b.Delay(fun () -> {| ce |}0), fun pi -> {| cei |}0))T(try ce finally e, V, C, q) =
Assert(not q); C(b.TryFinally(b.Delay(fun () -> {| ce |}0), fun () -> e))T(ce1; ce2, V, C, q) = C(b.Combine({| ce1 |}0, b.Delay(fun () -> {| ce2 |}0)))
これが示しているのは、while...do 式に対応する、Whileメソッド。try...with 式に対応するTryWithメソッド。try...finally式に対応するTryFinallyメソッド。そして、式の流れをコントロールする Combineメソッドの４つの式を変換するときに、暗黙的にDelayメソッドの呼び出しが挿入されることを意味している。F# は正確評価の言語なので、「member b.Delay(f:unit-> option<'a>) : unit -> option<'a> = f 」という様に、この時点では評価をせずにそのまま式を遅延した状態を維持しないと、コンピュテーション式そのものが評価される前に「{| try cexpr with | pattern_i -> expr_i |}」の cexpr の部分が評価されてしまうので、うまくない。ということです。MSDNで示されているシグネチャは、標準的なモナドベースで書かれていて、実用的なコンピュテーション式の書き方については言及していない感があり、わかりにくいところがあります。
これを踏まえて、次のステップへ行ってみましょう。
Step6 : 「{| try cexpr with | pattern_i -> expr_i |}」の cexpr の評価を遅延する
Step5 を踏まえて、次のように実装を変更してみましょう。
type MaybeBuilder() = member b.Bind(m, f) = Option.bind f m member b.Return(a) = Some a member b.ReturnFrom(m) = m member b.Zero() = None // modify member b.Delay(f:unit -> option<'a>) = f member b.TryWith (c:unit -> option<'a>, hander:exn -> option<'a>) = try c() with ex -> hander ex member b.Combine(x:option<'a>, y:unit -> option<'a>) = if Option.isSome x then x else y() let maybe = new MaybeBuilder()
TryWithメソッドだけではなく、Combineメソッドにも変更が必要ということに注目です。
Delayメソッドの中で処理の遅延をそのままにするかわりに、「{| try cexpr with | pattern_i -> expr_i |}」の cexpr の部分で、unit を適用して評価するように実装します。TryWith では、式が上から下（左から右）へ流れます。その式が Combineメソッドでも遅延されているので、このとき評価するように実装します。
let a : unit -> option<int> = maybe { let! x = None try return x / 0 with | e -> return 0 } a |> printfn "%A" // <fun:a@16> a () |> printfn "%A" // <null> ※None let b : unit -> option<int> = maybe { let! x = Some 10 try return x / 0 with | ex -> printf "%s" ex.Message return 0 } b |> printfn "%A" // <fun:b@26> b () |> printfn "%A" // 0 で除算しようとしました。Some 0
となります。try...with式が思った通りの挙動をするようになりました。
しかし、Delay によって unit を引数にとる関数になったままだと、どうも具合がよくありません。これは、Step7 で解決します。
Step7 : 最終的なコンピュテーション式の型を決定する Runメソッド
Step5 で、評価が遅延されるべき計算は、Delayメソッドによって包まれている(unitを引数にとる関数として)ことがわかりました。
しかし、遅延されたままだと具合がよくありません。そこで、Runメソッドの出番です。
6.3.10Computation Expressions - The F# 3.0 Language Specification
http://research.microsoft.com/en-us/um/cambridge/projects/fsharp/manual/spec.html#_Toc335818835
let b = builder-expr in b.Run (<@ {| cexpr |}C >@)
F#3.0 の言語仕様にありますように、Runメソッドは、ビルダークラスが評価されるときに呼びだされます。
つまり、「member b.Delay(f:unit-> option<'a>) = f 」に対して必要なRunメソッドの実装は「member b.Run(f:unit-> 'c) : 'c = f()」という感じになります。
type MaybeBuilder() = member b.Bind(m, f) = Option.bind f m member b.Return(a) = Some a member b.ReturnFrom(m) = m member b.Combine(x, y) = if Option.isSome x then x else y() member b.Zero() = None member b.Delay(f) = f member b.TryWith (c, hander) = try c() with ex -> hander ex // add member b.Run(f) = f() let maybe = new MaybeBuilder()
maybe { let! x = None try return x / 0 with | e -> return 0 } |> printfn "%A" // <null> maybe { let! x = Some 10 try x / 0 |> printf "%d" with | ex -> printf "%s" ex.Message return "ここまで" } |> printfn "%A" // 0 で除算しようとしました。Some "ここまで"
ということで、このツイートで言いたかったのはこういうことでした。
大した話でもないのにダラダラと書いてしまいました。でもまだ続きもあるのでよろしければ。
Step8 : 「try...finally式を使いたい！」TryFinallyメソッド
さて、try...finally式も利用できるように実装してみましょう。Step6 と Step7を踏まえれば難しくないですね。
また、DelayメソッドとRunメソッドがどのように呼ばれているのかを確認するために、printf を入れてみました。
type MaybeBuilder() = member b.Bind(m, f) = Option.bind f m member b.Return(a) = Some a member b.ReturnFrom(m) = m member b.Combine(x, y) = if Option.isSome x then x else y() member b.Zero() = None member b.TryWith (c, hander) = try c() with ex -> hander ex // add member b.TryFinally (c, f) = try c() finally f() // modify member b.Delay(f) = #if DEBUG printf "%s" "delay;" #endif f member b.Run(f) = f() |> fun x -> #if DEBUG printf "%s" "run;" #endif x let maybe = new MaybeBuilder()
maybe { try try printf "%s" "try" finally printf "%s" "finally1;" finally printf "%s" "finally2;" return "ここまで" } |> printfn "%A" // Debug : delay;delay;delay;tryfinally1;finally2;delay;run;Some "ここまで" // Relese: tryfinally1;finally2;Some "ここまで"
Debugモードで実行すると、「delay;delay;delay;tryfinally1;finally2;delay;run;Some "ここまで"」と出力されます。try...finally式を2回使っています。ここでDelayが2回呼ばれます。外側のtry...finally式で unit が返されますので、その後で既定値となる Zeroメソッドが呼ばれます。そのZeroメソッドで返された「None」と、 「return "ここまで"」がCombineメソッドで結合されるので、ここでも Delayが呼ばれます。Delayが呼ばれるのは、合計3回ですか？ でも、実際には合計4回呼ばれています。どういうことだってばよ？
このあたりのことは、言語仕様を読めばちゃんと書いてありますね。
6.3.10Computation Expressions - The F# 3.0 Language Specification
http://research.microsoft.com/en-us/um/cambridge/projects/fsharp/manual/spec.html#_Toc335818835
let b = builder-expr in b.Run (<@ b.Delay(fun () -> {| cexpr |}C) >@)
ビルダークラスに Delayメソッドが実装されているときに限り、上記のように評価されるのです。いつDelayメソッドが呼ばれるかを把握しておくことは大事です。暗黙的にDelayメソッドが呼ばれるタイミングは、Whileメソッド、TryWithメソッド、TryFinallyメソッド、Combineメソッド、Runメソッド、の５つです。これ以外にDelayメソッドが呼ばれるタイミングは、自分で明示的に呼ぶように実装した場合のみになります。ここテストに出ます！ちなみに、Runメソッドについてもビルダークラスに実装されている場合に限り呼び出しが行われます。
寄り道 : F#3.0のコンパイラのソースコードを読もう
Step9へ行く、その前にちょっと寄り道。F#3.0のコンパイラのソースコードを読もうのコーナー。
F#3.0のコンパイラのコンピュテーション式の分析をしているところのソースコードについて、いくつかピックアップして見てみる。
http://fsharppowerpack.codeplex.com/SourceControl/changeset/view/71313#1230866
まずはここらへん。ふむふむなるほど。コンピュテーション式の呼び出しを生成している関数のようです。
/// Make a builder.Method(...) call let mkSynCall nm (m:range) args = let m = m.MakeSynthetic() // Mark as synthetic so the language service won't pick it up. let args = match args with | [] -> SynExpr.Const(SynConst.Unit,m) | [arg] -> SynExpr.Paren(SynExpr.Paren(arg,range0,None,m),range0,None,m) | args -> SynExpr.Paren(SynExpr.Tuple(args,[],m),range0,None,m) let builderVal = mkSynIdGet m builderValName mkSynApp1 (SynExpr.DotGet(builderVal,range0,LongIdentWithDots([mkSynId m nm],[]), m)) args m
Whileメソッドを生成するとき、mkSynCall関数の引数に"Delay"が渡されているのか確認できます。ここで自動的に Delayメソッドが呼び出される構成が作られているんですね。
| SynExpr.While (spWhile,guardExpr,innerComp,_) -> let mGuard = guardExpr.Range let mWhile = match spWhile with SequencePointAtWhileLoop(m) -> m | _ -> mGuard if isQuery then error(Error(FSComp.SR.tcNoWhileInQuery(),mWhile)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mWhile ad "While" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("While"),mWhile)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mWhile ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),mWhile)) Some(trans true q varSpace innerComp (fun holeFill -> translatedCtxt (mkSynCall "While" mWhile [mkSynDelay2 guardExpr; mkSynCall "Delay" mWhile [mkSynDelay innerComp.Range holeFill]])) )
同様に、TryWithメソッド。
| SynExpr.TryWith (innerComp,_mTryToWith,clauses,_mWithToLast,mTryToLast,spTry,_spWith) -> let mTry = match spTry with SequencePointAtTry(m) -> m | _ -> mTryToLast if isQuery then error(Error(FSComp.SR.tcTryWithMayNotBeUsedInQueries(),mTry)) if q then error(Error(FSComp.SR.tcTryWithMayNotBeUsedWithCustomOperators(),mTry)) let clauses = clauses |> List.map (fun (Clause(pat,cond,clauseComp,patm,sp)) -> Clause(pat,cond,transNoQueryOps clauseComp,patm,sp)) let consumeExpr = SynExpr.MatchLambda(true,mTryToLast,clauses,NoSequencePointAtStickyBinding,mTryToLast) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "TryWith" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryWith"),mTry)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),mTry)) Some(translatedCtxt (mkSynCall "TryWith" mTry [mkSynCall "Delay" mTry [mkSynDelay2 (transNoQueryOps innerComp)]; consumeExpr]))
同様に、TryFinallyメソッド。
| SynExpr.TryFinally (innerComp,unwindExpr,mTryToLast,spTry,_spFinally) -> let mTry = match spTry with SequencePointAtTry(m) -> m | _ -> mTryToLast if isQuery then error(Error(FSComp.SR.tcNoTryFinallyInQuery(),mTry)) if q then error(Error(FSComp.SR.tcTryFinallyMayNotBeUsedWithCustomOperators(),mTry)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "TryFinally" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryFinally"),mTry)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),mTry)) Some (translatedCtxt (mkSynCall "TryFinally" mTry [mkSynCall "Delay" mTry [mkSynDelay innerComp.Range (transNoQueryOps innerComp)]; mkSynDelay2 unwindExpr]))
同様に、Combineメソッド。
| SynExpr.Sequential(sp,true,innerComp1,innerComp2,m) -> // Check for 'where x > y' and other mis-applications of infix operators. If detected, give a good error message, and just ignore innerComp1 if isQuery && checkForBinaryApp innerComp1 then Some (trans true q varSpace innerComp2 translatedCtxt) else if isQuery && not(innerComp1.IsArbExprAndThusAlreadyReportedError) then match innerComp1 with | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential | _ -> errorR(Error(FSComp.SR.tcUnrecognizedQueryOperator(),innerComp1.RangeOfFirstPortion)) match tryTrans true false varSpace innerComp1 id with | Some c -> // "cexpr; cexpr" is treated as builder.Combine(cexpr1,cexpr1) // This is not pretty - we have to decide which range markers we use for the calls to Combine and Delay // NOTE: we should probably suppress these sequence points altogether let m1 = match innerComp1 with | SynExpr.IfThenElse (_,_,_,_,_,mIfToThen,_m) -> mIfToThen | SynExpr.Match (SequencePointAtBinding mMatch,_,_,_,_) -> mMatch | SynExpr.TryWith (_,_,_,_,_,SequencePointAtTry mTry,_) -> mTry | SynExpr.TryFinally (_,_,_,SequencePointAtTry mTry,_) -> mTry | SynExpr.For (SequencePointAtForLoop mBind,_,_,_,_,_,_) -> mBind | SynExpr.ForEach (SequencePointAtForLoop mBind,_,_,_,_,_,_) -> mBind | SynExpr.While (SequencePointAtWhileLoop mWhile,_,_,_) -> mWhile | _ -> innerComp1.Range if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Combine" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Combine"),m)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),m)) Some (translatedCtxt (mkSynCall "Combine" m1 [c; mkSynCall "Delay" m1 [mkSynDelay innerComp2.Range (transNoQueryOps innerComp2)]]))
Step5 にあったとおりコンピュテーション式の中で、try...with式を利用するためには、TryWithメソッドに加えて、Delayメソッドも実装しなければなりませんでした。例えば TryWithメソッドがビルダークラスに実装されている場合、TryWithメソッドの呼び出しの中で Delayメソッドの呼び出しがコンパイラによって暗黙的に挟み込まれるということがわかります。「{| try cexpr with | pattern_i -> expr_i |}」の cexpr の部分にちょうど挿入されます。これは「このタイミングで挿入される Delayメソッドの呼び出しを利用して処理を遅延してね！」といわんばかりです。つまり、MSDNで示されている「通常のシグネチャ」はガン無視していただいて構わないということです。
ところで、ビルダークラスが評価されるタイミングについても、同じような挙動をするのでした。Runメソッドが実装されている場合のみ Runメソッドが呼び出されるようコンパイラさんがよろしくやってくれて、そのRunメソッドの中で、Delayメソッド呼ばれるかどうかについても、Delayメソッドが実装されているか否かによって判断されると、言語仕様に書いてありました。コンパイラさんのことは、コンパイラさんが一番よく知っているって、じっちゃんが言ってた。
関係ありそうなところを以下にピックアップ。
let mkSynDelay2 (e: SynExpr) = mkSynDelay (e.Range.MakeSynthetic()) e let delayedExpr = match TryFindIntrinsicOrExtensionMethInfo cenv env mBuilderVal ad "Delay" builderTy with | [] -> basicSynExpr | _ -> mkSynCall "Delay" mBuilderVal [(mkSynDelay2 basicSynExpr)] let quotedSynExpr = if isAutoQuote then SynExpr.Quote(mkSynIdGet (mBuilderVal.MakeSynthetic()) (CompileOpName "<@ @>"), (*isRaw=*)false, delayedExpr, (*isFromQueryExpression=*)true, mWhole) else delayedExpr let runExpr = match TryFindIntrinsicOrExtensionMethInfo cenv env mBuilderVal ad "Run" builderTy with | [] -> quotedSynExpr | _ -> mkSynCall "Run" mBuilderVal [quotedSynExpr]
runExprを見ると、Runメソッドがビルダークラスに実装されている場合のみ Runの呼び出しが生成され、同じく delayedExprを見ると、Delayメソッドが実装されている場合のみ 内部にDelay の呼び出しが生成される、と。
実際そのようになっているようです。コンパイラのソースを見れば...、いろいろとわかる（こともある）。オープンソースな F# いいね！
Step9 : 「use 束縛を使いたい！」Usingメソッド
少しばかり寄り道をしてしまいましたが、気を取り直して最後まで一気に駆け抜けましょう。
「use 束縛を使いたい！」そんなあなたは、Usingメソッドを実装しましょう。use 束縛は、C# や VBの using ステートメントにあたる働きをします。.NET開発者であれば、ご存知のとおり、IDisposableインターフェイスを実装しているオブジェクトについてリソースを解放をする働きがあるものです。
open System type MaybeBuilder() = member b.Bind(m, f) = Option.bind f m member b.Return(a) = Some a member b.ReturnFrom(m) = m member b.Combine(x, y) = if Option.isSome x then x else y() member b.Zero() = None member b.Delay(f) = f member b.TryWith (c, hander) = try c() with ex -> hander ex member b.Run(f) = f() member b.TryFinally (c, f) = try c() finally f() // add member b.Using(res:#IDisposable, body:#IDisposable -> option<'a>) : option<_>= b.TryFinally((fun ()-> body res), fun () -> match res with null -> () | x -> x.Dispose()) let maybe = new MaybeBuilder()
リソースの解放は、use キーワードで束縛した値のスコープが外れた場合。つまり式が最後まで評価された、あるいは例外が発生してスコープを外れた場合が考えられます。この実装には、先ほど実装した TryFinallyメソッドをそのまま利用することができます。TryFinallyメソッド使って簡単に実装しましょう。もちろん、「{| try cexpr with | pattern_i -> expr_i |}」の cexpr の部分には、コンパイラによって Delayメソッドの呼び出しが暗黙的に挿入されることになるので処理の呼び出しが遅延されます。
let createDisposable f = { new IDisposable with member x.Dispose() = f() } maybe { use res = createDisposable (fun () -> printf "%A" "Disposeされたよ;") return "おわり" } |> printfn "%A" // "Disposeされたよ";Some "おわり" maybe { try use outp = IO.File.CreateText(@"C:\test\playlist.txt") outp.WriteLine("口がすべって") outp.WriteLine("君が好き") outp.WriteLine("言わせてみてぇもんだ") with ex -> printf "%A" ex } |> printfn "%A" // <null>
use 束縛は、let 束縛と同じ機能が提供されているだけでなく、束縛した値がスコープの外に出ると対象のオブジェクトの Dispose が呼び出されます。
また、コンパイラによって値の null チェックが挿入されますので、値が null の場合には Dispose の呼び出しは行われません。
Step10 : 「while...do式を使いたい！」Whileメソッド
コンピュテーション式で、「while...do式を使いたい！」という場合は、Whileメソッドを実装します。
open System type MaybeBuilder() = member b.Bind(m, f) = Option.bind f m member b.Return(a) = Some a member b.ReturnFrom(m) = m member b.Combine(x, y) = if Option.isSome x then x else y() member b.Zero() = None member b.Delay(f) = f member b.TryWith (c, hander) = try c() with ex -> hander ex member b.Run(f) = f() member b.TryFinally (c, f) = try c() finally f() member b.Using(res:#IDisposable, body:#IDisposable -> option<'a>) : option<_>= b.TryFinally((fun ()-> body res), fun () -> match res with null -> () | x -> x.Dispose()) // add member b.While(guard:unit -> bool, f:unit -> option<'a>) = if not (guard()) then b.Zero() else b.Bind(f(), fun _ -> b.While(guard, f)) let maybe = new MaybeBuilder()
実装をご覧いただくとわかるように、Zeroメソッド、Bindメソッド、Whileメソッド（自身）を呼び出しています。指定した条件が falseとなったときループを抜けて、上から下（左から右）へ計算式が流れていきます。ここで Zeroメソッドを呼び出すことで既定値の計算式を下（右）へ流しています。条件が true の場合は、上（左）から流れてきた計算式の計算結果と、以後に継続されるループを表す式を 、Bindメソッドによって束縛と関数適用を繰り返すことで計算を再帰的につなぎ合わせています。ループの実装は、対象とする文脈によって特に実装内容が大きく異なってきますが、基本的にはこのような流れで実装することになるでしょう。
maybe { let i = ref 0 while !i < 10 do printf "%d;" !i incr i } |> printfn "%A" // 0;<null> maybe { let i = ref 0 while !i < 10 do printf "%d" !i incr i return! Some (printf "%s" "個;" ) return "ここまで" } |> printfn "%A" // 0個;1個;2個;3個;4個;5個;6個;7個;8個;9個;Some "ここまで" maybe { let i = ref 10 while !i >= 0 do try printf "%d;" <| 10 / !i decr i return () with | ex -> printf "%s" ex.Message return 999 } |> printfn "%A" // 1;1;1;1;1;2;2;3;5;10;0 で除算しようとしました。Some 999
Step11 : 「for...do式を使いたい！」Forメソッド
コンピュテーション式で、「for...do式を使いたい！」というニーズは結構多いのではないかと思います。
これまでのStepの中で実装してきたメソッドを活かしながら Forメソッドを実装してみましょう。
open System type MaybeBuilder() = member b.Bind(m, f) = Option.bind f m member b.Return(a) = Some a member b.ReturnFrom(m) = m member b.Combine(x, y) = if Option.isSome x then x else y() member b.Zero() = None member b.Delay(f) = f member b.TryWith (c, hander) = try c() with ex -> hander ex member b.Run(f) = f() member b.TryFinally (c, f) = try c() finally f() member b.Using(res:#IDisposable, body:#IDisposable -> option<'a>) : option<_>= b.TryFinally((fun ()-> body res), fun () -> match res with null -> () | x -> x.Dispose()) member b.While(guard:unit -> bool, f:unit -> option<'a>) = if not (guard()) then b.Zero() else b.Bind(f(), fun _ -> b.While(guard, f)) // add member this.For(sequence:#seq<_>, body) = this.Using(sequence.GetEnumerator(), fun enum -> this.While(enum.MoveNext, (fun () -> body enum.Current))) let maybe = new MaybeBuilder()
シーケンスのリソースは解放する必要があるので、実装済みのUsingメソッドを利用します。ループの表現には先程実装したWhileメソッドを利用します。Usingメソッドと、Whileメソッドを利用して、Forを実装することができました。
maybe { for i in [1..5] do printf "%d;" i return "Combineで式が結合されてコレは捨てられます" return "おしまい" } |> printfn "%A" // 1;2;3;4;5;Some "おしまい" maybe { for i in [1..5] do return printf "%d;" i return "おしまい" } |> printfn "%A" // 1;2;3;4;5;Some "おしまい"
残るは、Yieldメソッド と YieldFromメソッドの実装。と言いたいところですが、Maybeモナドの文脈では、Yieldメソッドおよび YieldFromメソッドを実装する意味はありませんので省略します*2。ということで、すべてのステップが終了しました。これでおしまいです。以上、「ステップアップでわかるコンピュテーション式」でした。何かの参考になれば幸いです。
おまけ：FsControlを拡張してお遊び
Gustavo Leon氏(@gmpl)のGJ(グッジョブ)であるところの、fsharp-typeclasses
https://code.google.com/p/fsharp-typeclasses/
を、新しく構成しなおしたプロジェクト FsControl が面白くてニヤニヤしながらたまーに見ていたりします。
https://github.com/gmpl/FsControl
そのキモとなるのが、InlinHelperモジュール。
[<AutoOpen>] module InlineHelper module Overloads = let inline instance_1 (a:^a ) = ( ^a : (static member instance: ^a -> _) (a )) let inline instance_2 (a:^a,b:^b ) = ((^a or ^b ) : (static member instance: ^a* ^b -> _) (a,b )) let inline instance_3 (a:^a,b:^b,c:^c ) = ((^a or ^b or ^c ) : (static member instance: ^a* ^b* ^c -> _) (a,b,c )) let inline instance_4 (a:^a,b:^b,c:^c,d:^d ) = ((^a or ^b or ^c or ^d ) : (static member instance: ^a* ^b* ^c* ^d -> _) (a,b,c,d )) let inline instance_5 (a:^a,b:^b,c:^c,d:^d,e:^e ) = ((^a or ^b or ^c or ^d or ^e ) : (static member instance: ^a* ^b* ^c* ^d* ^e -> _) (a,b,c,d,e )) let inline instance_6 (a:^a,b:^b,c:^c,d:^d,e:^e,f:^f) = ((^a or ^b or ^c or ^d or ^e or ^f) : (static member instance: ^a* ^b* ^c* ^d* ^e* ^f -> _) (a,b,c,d,e,f)) open Overloads type Inline = Inline with static member inline instance ( ) = fun (x:'x) -> instance_1( Unchecked.defaultof<'r>) x :'r static member inline instance (a:'a ) = fun (x:'x) -> instance_2(a ,Unchecked.defaultof<'r>) x :'r static member inline instance (a:'a, b:'b ) = fun (x:'x) -> instance_3(a,b ,Unchecked.defaultof<'r>) x :'r static member inline instance (a:'a, b:'b, c:'c ) = fun (x:'x) -> instance_4(a,b,c ,Unchecked.defaultof<'r>) x :'r static member inline instance (a:'a, b:'b, c:'c, d:'d ) = fun (x:'x) -> instance_5(a,b,c,d ,Unchecked.defaultof<'r>) x :'r static member inline instance (a:'a, b:'b, c:'c, d:'d, e:'e) = fun (x:'x) -> instance_6(a,b,c,d,e,Unchecked.defaultof<'r>) x :'r
これがなんとも黒魔術的であり、メシウマ状態であり。その一方で"今の F#"の限界を感じたり。
で、FsControl では、fsharp-typeclasses にあった、DoNotationBuilderを提供する do' が internalで宣言されていたり、DoPlusNotationBuilderとそのインスタンスを提供する doPlus がなくなっていたり、いろいろ変更が加えられている。また、FsControlというプロジェクトからは、なみなみならぬ Haskell愛 を感じるわけだけど、F# 愛の成分が不足しているように感じる。というのも、この記事で取り上げた コンピュテーション式内で利用できる for式 や try...with 式などの Haskell にはない機能についての利用は考えられていないからだ。FsControl はあくまで Haskell 的な関数型プログラミングのエミュレートを提供するという思想で作られているのかもしれない、とかなんとか。
ということで、お遊び程度でちょっとゴニョゴニョしてみました。なんか表示が崩れてしまうので埋め込みはしません。
https://gist.github.com/zecl/5280535
Whileメソッド以下については、ちょっと工夫しないと厳しそうな気がします。なので宿題とします（ｷﾘｯ
すごいH本の素朴な確率モナド
年末年始の連休から中五日あっての三連休で、正月ボケをぶり返してしまいそうな今日この頃ですが、いかがお過ごしでしょうか。
すごいH本こと、書籍「すごいHaskellたのしく学ぼう！」の最後のほう、第１４章「もうちょっとだけモナド」の 14.8 (P356)にて、素朴な確率モナドが紹介されています。
- 作者: Miran Lipovača,田中英行,村主崇行
- 出版社/メーカー: オーム社
- 発売日: 2012/05/23
- メディア: 単行本（ソフトカバー）
- 購入: 25人 クリック: 580回
- この商品を含むブログ (51件) を見る
普通、モナドは作りたいと思って作るものではありません。むしろ、とある問題のある側面をモデル化した型を作り、後からその型が文脈付きの値を表現していてモナドのように振る舞うと分かった場合に、Monad のインスタンスを与える場合が多いです。
というのが印象的で。ふむふむ確かになるほどなあという感じです。
ぼけーっと、ただ連休をだらだらと過ごすだけなのもなんなので、正月ボケのリハビリを兼ねて何か書いておこうかなということで、これを F# で書いてみようと思います。
確率を表現するための有理数を表す型
数学では通常、確率はパーセント（％）ではなく、0 から 1 までの実数で表します。確率が 0 ということは絶対にありえないということであり、確率が 1 というのは確実に起こるということを意味します。確率を浮動小数点で表すのも間違いではないのですが、どうしても精度が落ちてしまう。そこで Haskell では、Rationalという分数を表すために最適な有理数を表す型があり、例えば ４分の１は、1%4 のように、分子と分母は % で区切って表現することができる。では、F# はどうでしょう。標準には用意されていませんが、F# では、F# PowerPack という追加ライブラリにて数学に関する様々な機能が提供されています。これを導入することで分数の表現に対応することができます(NuGetで簡単に導入することもできます)。有理数を表すことができる BigRational という型が定義されているので、それを使えます。BigRational は、Nリテラルを用いて表現することができ、４分の１は、1N/4N というように表せます。
F# で素朴な確率モナド
Haskellでの実装例は書籍や(Learn You a Haskell for Great Good! - For a Few Monads More)に出ている通りなので、そちらを参照されたい。BigRational型と FSharpx を使って、F# で素朴な確率モナドをとりえず実装してみる。
namespace FSharpx.Monad // 素朴な確率モナド module Probability = let probMap f m = List.map (fun (x,p) -> (f x, p)) m type ProbBuilder() = member this.ReturnFrom(x) = x member this.Return(x) = [x,1N/1N] member this.Bind(m, f) = let flatten xs = let concatMap f m = List.concat( List.map (fun x -> f x) m ) let multAll (innerxs,p) = List.map (fun (x,r) -> (x, p*r)) innerxs concatMap multAll xs flatten (probMap f m) member this.Zero () = [] let prob = new ProbBuilder() open FSharpx open Operators let inline returnM x = returnM prob x let inline (>>=) m f = bindM prob m f let inline (=<<) f m = bindM prob m f let inline (<*>) f m = applyM prob prob f m let inline ap m f = f <*> m let inline map f m = liftM prob f m let inline (<!>) f m = map f m let inline lift2 f a b = returnM f <*> a <*> b let inline lift3 f a b c = returnM f <*> a <*> b <*> c let inline ( *>) x y = lift2 (fun _ z -> z) x y let inline ( <*) x y = lift2 (fun z _ -> z) x y let inline (>>.) m f = bindM prob m (fun _ -> f) let inline (>=>) f g = fun x -> f x >>= g let inline (<=<) x = flip (>=>) x
使ってみる。３枚のコイン（イカサマコインが１つ混入している）がすべて裏が出る確率を出す。
module Program = open System open FSharpx.Monad.Probability type Coin = Heads | Tails let coin = [(Heads,1N/2N); (Tails,1N/2N)] let loadedCoin = [(Heads,1N/10N); (Tails,9N/10N)] let flipThree = prob { let! a = coin let! b = coin let! c = loadedCoin return List.forall (function |Tails->true |_->false) [a;b;c] } flipThree |> printfn "%A"
実行結果
[(false, 1/40N); (false, 9/40N); (false, 1/40N); (false, 9/40N); (false, 1/40N); (false, 9/40N); (false, 1/40N); (true, 9/40N)]
確率モナドによって、３枚とも裏が出る確率は、４０分の９であると導きだすことができた。すごいH本と同じ結果になりましたね。めでたしめでたし。
続いて、6面のサイコロを２回振ったとき、その出目の合計値ごとの確率を出してみる。
let d sides = [for i in [1 .. sides] -> (i, 1N/ BigRational.FromInt(sides))] let dice = d 6 let diceTwoSum = prob { let! a = dice let! b = dice return a+b } diceTwoSum |> printfn "%A"
実行結果
[(2, 1/36N); (3, 1/36N); (4, 1/36N); (5, 1/36N); (6, 1/36N); (7, 1/36N); (3, 1/36N); (4, 1/36N); (5, 1/36N); (6, 1/36N); (7, 1/36N); (8, 1/36N); (4, 1/36N); (5, 1/36N); (6, 1/36N); (7, 1/36N); (8, 1/36N); (9, 1/36N); (5, 1/36N); (6, 1/36N); (7, 1/36N); (8, 1/36N); (9, 1/36N); (10, 1/36N); (6, 1/36N); (7, 1/36N); (8, 1/36N); (9, 1/36N); (10, 1/36N); (11, 1/36N); (7, 1/36N); (8, 1/36N); (9, 1/36N); (10, 1/36N); (11, 1/36N); (12, 1/36N)]
ここまでがすごいH本で書かれている範囲でできること。これから先については、読者への演習問題としている。
上記の実行結果を見てわかるように、確率の結果がまとまっておらず、バラバラに出力されていて結果の内容がわかりにくい。これはひどい。
できれば、
[(false, 31/40N); (true, 9/40N)]
とか
[(2, 1/36N); (3, 1/18N); (4, 1/12N); (5, 1/9N); (6, 5/36N); (7, 1/6N); (8, 5/36N); (9, 1/9N); (10, 1/12N); (11, 1/18N); (12, 1/36N)]
というように、結果が一致する事象の確率については１つにまとめて出力してくれるのが分かり易くて理想だよね、と。せっかくなので、この演習問題をやってみましょう。
とりあえず、結果が一致する事象の確率を１つにまとめてみる
あまり何も考えずに、とりあえず実装してみた版。
let rec merge (k,p) xs = xs |> function | [] -> [] | (k,p)::kps -> kps |> function | [] -> [(k,p)] | (k',p')::kps' -> if k = k' then (k,p+p')::(merge (k,p) kps') else (k,p)::(merge (k',p') kps) let agglomerate f pd = let xs : ('b * BigRational) list = (probMap f pd) |> List.sort List.foldBack merge pd xs let agg pd = agglomerate id pd
使ってみる。
let flipThree = prob { let! a = coin let! b = coin let! c = loadedCoin return List.forall (function |Tails->true |_->false) [a;b;c] } flipThree |> agg |> printfn "%A" //let flipThree2 = agg <| lift3 (fun a b c -> List.forall (function |Tails->true |_->false) [a;b;c]) coin coin loadedCoin //flipThree2 |> printfn "%A"
実行結果
[(false, 31/40N); (true, 9/40N)]
使ってみる。
let d sides = [for i in [1 .. sides] -> (i, 1N/ BigRational.FromInt(sides))] let dice = d 6 let diceTwoSum = prob { let! a = dice let! b = dice return a+b } diceTwoSum |> agg |> printfn "%A" //let diceTwoSum2 = agg <| lift2 (+) dice dice //diceTwoSum2 |> printfn "%A"
実行結果
[(2, 1/36N); (3, 1/18N); (4, 1/12N); (5, 1/9N); (6, 5/36N); (7, 1/6N); (8, 5/36N); (9, 1/9N); (10, 1/12N); (11, 1/18N); (12, 1/36N)]
うん。とりあえず動いているね。これで一応目的は達成できているのだけど、なんだか冗長な感じがするしカッコ悪い。俺が欲しいのコレジャナイ感がぱない。もっとシンプルに行きたい。
結果が一致する事象の確率を１つにまとめる（改訂版）
どのあたりがコレジャナイ感を出しているのか。落ち着いて先ほどの実装をよく見てみてみよう。
let rec merge (k,p) xs = xs |> function | [] -> [] | (k,p)::kps -> kps |> function | [] -> [(k,p)] | (k',p')::kps' -> if k = k' then (k,p+p')::(merge (k,p) kps') else (k,p)::(merge (k',p') kps) let agglomerate f pd = let xs : ('b * BigRational) list = (probMap f pd) |> List.sort List.foldBack merge pd xs let agg pd = agglomerate id pd
List.sort でソートしたリストと、ソートする前のリストとを比較して、再帰でマージしながら結果をまとめあげる実装となっている。
そもそもここでやりたいことは、集合として確率の結果をまとめ上げたいということ。集合を扱いたい場合、F# では set が使える。また、コレジャナイ実装では、List.foldBack で入力要素を順々に受け取りながら marge 関数で確率の和を求めながら結果の状態を順次更新していっているが、set を使って集合化することができれば、集合の要素ごとの確率の和をそれぞれ算出してゆくだけでよいことになる。あ、それって List.reduce 使えばいんじゃね？ となる。
ところで、List.reduce とはなんだったのか。例えば、List.foldを用いてintのリストの和を求める場合を思い出してみよう。
List.fold (+) 0 [1;2;3]
のように書けるのでした。育てる種となる初期値の 0 を与えて、次々にリストを畳み込むことにより、結果 6 が得られる。
ここで、育てる種となる初期値の 0 を与えずにリストの和を求めるには、育てる種の初期値としてリストの最初の要素を採用すればよい。最初の要素と次の要素によって演算を開始するという処理を行えばよいことなる。
こう書く事ができる。
List.reduce (+) [1;2;3]
そう、List.fold が簡易化されたものが List.reduce ということだった。
ということで集合を扱える set と 育てる種を必要としない List.reduce を用いて実装すると次のように書ける。
let merge f (a,x) (b,y) : 'a * BigRational = f a b, x + y let agglomerate f pd = let d = pd |> List.map(fun (x,_) -> x) |> set |> Set.toList List.map (fun x -> List.filter(fun (y,b) -> x = y) pd |> List.reduce (merge f)) d let agg pd = agglomerate (fun _ x -> x) pd
ほむ。だいぶシンプルになりました。これはリハビリをして正解でしたね。
