ようこそ。睡眠不足なプログラマのチラ裏です。
トップ > F#2.0

オブジェクト指向は、シンプルできれいだが脆い。関数型プログラミングは、強く美しいが複雑。F#はいろいろな書き方が混ぜこぜになるよ。楽しいよ。

プログラミング F#2.0 F# C# VB.NET Silverlight WPF オブジェクト指向 関数型プログラミング

オブジェクト指向プログラミングが好きだ。関数型プログラミングが好きだ。


オブジェクト指向プログラミング

オブジェクト指向プログラミングは、コンテナの一般性を確保している点で優れている。
データと振る舞いをコンテナとしてまとめることで、プログラムをわかりやすく整理するという特徴がある。
特定のコンテナ自体を値として別のコンテナに収めたり、操作に対してパラメータ(引数)として受け渡すことでプログラムを表現する。
そのコンテナをオブジェクトって呼んでいる。


データと操作をオブジェクトとしてまとめる利点は、オブジェクトそのものに責務を定義できるからだ。
オブジェクトはそもそも自身の型を知っているので、オブジェクト内のデータによってその状態を識別できる。
カプセル化された実装によって、果たすべき機能が適切に表現される。ただし、オブジェクトで状態を扱うと
必ず副作用を巻き込んでしまうので「脆さ」が見え隠れする。そこで考え出されたのが不変オブジェクト。
不変オブジェクトの利用はオブジェクト指向プログラミングにおいて重要な要素のひとつだ。
オブジェクト指向プログラミングは、シンプルできれいだが脆いプログラミングスタイル。好きだ。


関数型プログラミング

関数型プログラミングは、関数を一人前の値(ファーストクラスオブジェクト)として扱える点で優れいている。
より高いレベルで操作を抽象化できるので新らたな制御構造を構築しやすい。
つまり、関数（計算）を連鎖させる(組み合わせる)ことで、あらゆる操作を柔軟に表現できる。
そこには本当の意味でのプログラムの再利用性と拡張性がある。関数型プログラミングの発想においては、操作はデータ(状態)を変更するのではなく、
入力を出力にマップ(写像)する考え方が基本となる。これ言うのは簡単で、やるのは少し頭をつかう。
いや、少しとは言い難い複雑さ難解さを伴うことも少なくないのが関数型だ。だがそれがいい。
モナドを勉強すると、関数型プログラミングを理解する大きな助けになる。時間はかかってもいい。勉強したい。


上手に関数を一般化できるようになると、表現力が格段に上がるので
簡潔で読みやすく美しいプログラムを書くことができる。副作用に対する心配が軽減されて、テスト容易性、保守性も抜群だ。
関数型プログラミングは、強く美しいが複雑なプログラミングスタイル。好きだ。


F#でオブジェクト指向プログラミングをすることはやぶさかではない。
F#は関数型言語だ。でもハイブリッドでイケてる言語なのでオブジェクト指向もできる。


F#は.NET Framework上にある関数型言語。実のところ関数だってその正体はオブジェクトだ。
.NET Framework上にあるので、容易にそのライブラリの恩恵を享受することができる。
VB.NETユーザーやC#ユーザーにとって、これはかなりうれしいアドバンテージだ。
現役.NETerが関数型言語を学ぶなら、何も迷う必要なんてない間違いなくF#だ。F#をおすすめする。


.NET Frameworkはオブジェクト指向で実装されている。であるからして、
F#で利用する場合は、その恩恵を受けると同時に「状態」という名の副作用の相手をしなければならないことが往々にしてある。
多くの「状態」を扱うのであれば、オブジェクト指向を採用すればシンプルに表現することができる。
F#はそれができる。したがって、F#でオブジェクト指向プログラミングをすることはやぶさかではない。
VB.NETやC#などで経験してきた、オブジェクト指向の設計パターンやアーキテクチャを再利用したいことがある。
F#はそれができる。したがって、最適解ではないかもしれないが、
F#でオブジェクト指向プログラミングをすることはやぶさかではない。


さまざまなトレードオフとの葛藤。混ぜこぜ楽しい
F#は関数型言語だよ。でもハイブリッドでイケてる言語なのでオブジェクト指向もできるよ。
じゃあF#でどう書く？


基本的には関数型プログラミングのスタイルで書くことが推奨される。なぜなら、強く美しいから。
でもね。.NET Frameworkとお友達である以上、いろいろと難しいことも出てくる。
F#でWPFやSilverlightを扱おうとすると、大小含めていろいろな副作用と付き合う羽目になる。
脳が自然とオブジェクト指向したくなっちゃう*1。オブ脳発動は自然な流れ。これはもうある意味仕方がないことだ。
だからF#でプログラムを書くと、さまざまトレードオフと葛藤しながら、いろいろな書き方が混ぜこぜになるよ。
これはね。最初はどことなく気持ち悪さも感じたんだけど、今では結構しっくり来る。混ぜこぜ楽しい。


「オブジェクト指向プログラミングしているコードは美しい」そう思っていた時期が俺にもありました。
まぁ間違いってわけじゃないんだけど、適切な表現か？というと今はなんか微妙に違う気がしている。
オブジェクト指向プログラミングってのは「美しい」というよりかは、「きれい」なんだよね。
整理整頓されているね的な意味で。関数型プログラミングしているコードは強く美しい。かっこいい。
もちろんアート的な意味でね。どちらもプログラミングに必要な要素だと思う。


まとめ
F#でプログラミングをすると、いろいろな書き方が混ぜこぜになるよ。
それは決して悪いことではないよ。F#によるマルチパラダイムなプログラミングはとても楽しいよ。


F#しようよ！

*1:今のところ、F#でオブジェクト指向プログラミングをするのは少し面倒なことも多いんだけど、言語仕様とIDEの強化などで少しずつ改善されていくと信じている。

F#で楽々breakとcontinue。継続モナドまじパネぇっす！

プログラミング F#2.0 F# Haskell 継続 コンピューテーション式 モナド

id:einblickerさんが、「F#で継続モナド - einblickerの日記」というステキな記事を書いてくださいました。グッジョブすぎる！


以前、F#で継続渡し形式(CPS)変換を抽象的に考えてみたら、それってつまりHaskellの継続モナドみたいなものでした。ということで継続ワークフロー(簡易版)作った。という記事を書いたのですが、
当時の私には継続モナドはとても難しく、モナドで包む部分とcallCCについて華麗にスルーしていました。
今回、einblickerさんのコードを読んで、継続モナドについて少し理解が深まりました。相変わらずとても難しいんですけど。


で、コードを読んでいて少し気づいたことがあったので、
einblickerさんのコードを踏まえつつ、自分ならこんな風に書くかなーというのを書いてみました。が、間違えていました。
コメントにてeinblickerさんにご指摘いただいたとおりに修正しました。また、YieldとYieldFromの実装を追加しました。
どうもありがとうございます。もう一度見直してみます。


ContMonad.fs

namespace Monad.ContMonad

[<AutoOpen>]
module ContMonad =
  type Cont<'r, 'a> = Cont of (('a -> 'r) -> 'r)

  let runCont (Cont c) = c
  let callCC f = Cont <| fun k -> runCont (f (fun a -> Cont <| fun _ -> k a)) k
  let creturn a = Cont <| fun k -> k a

  type ContBuilder () = 
    member this.Return(a) = creturn a 
    member this.ReturnFrom(a) = a
    member this.Bind(Cont c, f) = Cont <| fun k -> c (fun a -> runCont (f a) k)
    member this.Zero() = this.Return()
    member this.Combine(c1, c2) = this.Bind(c1, fun _ -> c2)
    member this.For(seq, f) = Seq.fold
                                (fun cc elem -> this.Combine(cc, f elem))
                                (f <| Seq.head seq) <| Seq.skip 1 seq
    member this.Delay (f) = f ()
    member this.Yield (a) = creturn a
    member this.YieldFrom (a) = a

  let cont = new ContBuilder ()

  type ContBuilder with 
    member this.foreach seq f =
      cont {
        do! callCC <| fun break' -> cont {
          for i in seq do
            do! callCC <| fun continue' -> cont {
              do! f i (break'()) (continue'())
            }
        }
      } |> runCont <| ignore


Sample.fs

namespace ConsoleApplication1

module Sample = 
  open Monad.ContMonad
  cont.foreach [1..20] (fun i  break' continue' -> cont {
      if i = 18 then
        do! break'
        printfn "foo"
      else if i % 2 = 0 then
        do! continue'
        printfn "bar"
      else
        printfn "%d" i
  })

  System.Console.WriteLine () |> ignore

  cont.foreach [1..20] (fun i  break' continue' -> cont {
      if i = 18 then
        do! break'
        printfn "foo"
      else
        for x in 1..i do
          printf "%d" x
        printfn ""
  })

  System.Console.ReadLine () |> ignore


実行結果

1
3
5
7
9
11
13
15
17

1
12
123
1234
12345
123456
1234567
12345678
123456789
12345678910
1234567891011
123456789101112
12345678910111213
1234567891011121314
123456789101112131415
12345678910111213141516
1234567891011121314151617


F#で楽々breakとcontinueできちゃってるよ。継続モナドまじパネぇっす！
（よいこは、「C#ならふつうにbreakとcontinueできるじゃん」とかなんとか言わない。）
ちなみに、 break と continue の２つのキーワードは将来利用するために予約されているので、
F#の今後のバージョンでサポートされるかもしれません。


おまけ：モナド則の確認

namespace ContMonad.UT

open System

module Tests = 
  open NUnit.Framework
  open FsUnit
  open Monad.ContMonad
      
  [<TestFixture>]
  type ``ContMonad モナド則`` () =
    let (>>=) m f = cont {let! x = m
                          return! f x}
    let return' x = cont { return x }

    let x = 1
    let m = cont { return 3 }
    let f x = cont { return 4 + x }
    let g x = cont { return 2 * x }

    let assertEqual (left, right) = 
      let result = cont {let! a1 = left
                         let! a2 = right
                         return a1 |> should equal a2} |> runCont <| ignore
      ()

    let (==) left right = assertEqual (left, right)

    [<Test>] 
    // モナド則１： return x >>= f == f x
    member test.``モナド則1`` () =
      return' x >>= f == f x

    [<Test>] 
    // モナド則２: m >>= return == m
    member test.``モナド則2`` () =
      m >>= return' == m

    [<Test>] 
    // モナド則３: (m >>= f) >>= g == m >>= (\x -> f x >>= g)
    member test.``モナド則3`` () =
      (m >>= f) >>= g == (m >>= (fun x -> f x >>= g))

  // nunit-gui-runner
  let main () = NUnit.Gui.AppEntry.Main([|System.Windows.Forms.Application.ExecutablePath|]) |> ignore
  main ()

Observableコンピューテーション式はモナド則を満たしているか否か。

プログラミング F#2.0 F# Rx コンピューテーション式 Haskell モナド

前回のエントリ「F#でRxる。よく訓練されたF#erはコンピューテーション式をつくる。」で紹介いたしました、
Observableコンピューテーション式について補足します。モナド則を満たしているか否かについてです。


Haskellにおいて、モナドがモナド則を満たしているとき、

1. (return x) >>= f == f x
　
2. m >>= return == m
　
3. (m >>= f) >>= g == m >>= (\x -> f x >>= g)

以上の三つの条件に満足しています。



モナドのすべてによると、最初の規則は return が >>=*1 に関して左単位元に なっていることを要請していて、
二番目の規則は return が >>= に関して右単位元になっていることを要請してる。 最後の規則は >>= に関する一種の結合法則とのことです。
これを初めて読んだときはさっぱりわかりませんでした。今も確信を持ってわかったとは言いきれませんが、まぁ、なんとなく雰囲気はつかんでいるつもりです。



Observableのコンピューテーション式では、どうでしょうか。

namespace FSharp.Rx.UT

open System

module Tests = 
  open System.Reactive 
  open NUnit.Framework
  open FsUnit
  open FSharp
  open FSharp.Rx
      
  [<TestFixture>]
  type ``monad soku `` () =
    [<Test>] 
    // モナド則１： return x >>= f == f x
    // return された値を保持するための変数(というか継続)は、なくしてしまうことができますよの規則
    // モナドで計算を繋ぐにしろ、もともと繋がっている計算をモナドでくるんでも一緒だね
    member test.``monad soku1`` () =
      observable {
        let! a1 = observable{ let! a = observable {return fun x -> x * 2} 
                              let! b = observable {return 3} 
                              return a b}
        let! a2 = observable{ return 3 |> fun x -> x * 2 }
        return a1 |> should equal a2
      } |> Rx.subscribe(fun _ -> ()) |> ignore 

    [<Test>] 
    // モナド則２： m >>= return == m
    // bindしてreturnしても結局同じことだよねの規則
    // あるいは、結局最後の式が return されることになるので、明示的な return は意味ナッシンというお話
    member test.``monad soku2`` () =
      let m1 = observable{ let! a = observable {return "F#"} 
                           return a}
      let m2 = observable{ return "F#" }
      Reactive.Testing.Extensions.AssertEqual(m1, m2)

    // モナド則３： m >>= (\x -> f x >>= g) == (m >>= f) >>= g
    // 多段ネストしたモナドでも(どんなに深くても)、結局のところ一段のモナドと等価ですよの規則
    [<Test>] 
    member test.``monad soku3`` () =
      let m1 = observable{ let! a = observable {return 3} 
                           let! b = observable {return 4}
                           let! x = observable {let! d = observable{return a}
                                                let! e = observable{return b}
                                                return d + e}
                           let! c = observable {return fun x -> x * 2}
                           return c x}
      let m2 = observable{ return 3 + 4 |> fun x -> x * 2 }
      Reactive.Testing.Extensions.AssertEqual(m1, m2)

  // nunit-gui-runner
  let main () = NUnit.Gui.AppEntry.Main([|System.Windows.Forms.Application.ExecutablePath|]) |> ignore
  main ()


ごくごく単純な確認ですので、正確な証明とまではいきませんが、
Observableコンピューテーション式が、モナド則を満たしているであろうことをゆるく確認することができます。
てゆうか、Observableコンピューテーション式は、単純にRxのObservableをはめ込んで適用しただけの代物なので、
Rxがそもそもモナド則を満たしているというのが本当のところです。RxのObservableはまさにモナドなのです。





[追記]

@nobuhisa_kさんに、コメントにてナイスつっこみを頂きました！
おっしゃるとおりで、上記のモナド則３の確認は間違えていますね。
モナド則３は、誤解を恐れずイメージしやすいように大雑把に言うと、「(2 * 3) * 4 * 5 == 2 * (3 * 4) * 5」だよねみたいな。
モナドにおいてもこれと同じことが成立していて欲しいと。していなきゃ困ると。


ということで、丸パクリで書き直してみました。


お手軽にお試しできる版

let x = 1
let m = observable { return 3 }
let f x = observable { return 4 + x }
let g x = observable { return 2 * x }
let (>>=) m f = observable {let! x = m
                            return! f x}

let return' x = observable { return x }

let prove (left,right) = 
  observable {let! x = (left:IObservable<'a>)
              let! y = (right:IObservable<'a>)
              return x = y}

prove (return' x >>= f, f x) |> Rx.subscribe(fun b -> printfn "モナド則1 : %b" b) |> ignore // true
prove (m >>= return', m) |> Rx.subscribe (fun b -> printfn "モナド則2 : %b" b) |> ignore // true
prove ((m >>= f) >>= g, m >>= (fun x -> f x >>= g)) |> Rx.subscribe(fun b -> printfn "モナド則3 : %b" b) |> ignore // true

よりテストっぽく

namespace FSharp.Rx.UT

open System

module Tests = 
  open System.Reactive 
  open NUnit.Framework
  open FsUnit
  open FSharp
  open FSharp.Rx
      
  [<TestFixture>]
  type ``Observable モナド則`` () =
    let (>>=) m f = observable {let! x = m
                                return! f x}
    let return' x = observable { return x }

    let x = 1
    let m = observable { return 3 }
    let f x = observable { return 4 + x }
    let g x = observable { return 2 * x }

    let assertEqual (left, right) = Reactive.Testing.Extensions.AssertEqual((left:IObservable<'a>), right)
    let (==) left right = assertEqual (left, right)

    [<Test>] 
    // モナド則１： return x >>= f == f x
    member test.``モナド則1`` () =
      return' x >>= f == f x

    [<Test>] 
    // モナド則２: m >>= return == m
    member test.``モナド則2`` () =
      m >>= return' == m

    [<Test>] 
    // モナド則３: (m >>= f) >>= g == m >>= (\x -> f x >>= g)
    member test.``モナド則3`` () =
      (m >>= f) >>= g == (m >>= (fun x -> f x >>= g))

  // nunit-gui-runner
  let main () = NUnit.Gui.AppEntry.Main([|System.Windows.Forms.Application.ExecutablePath|]) |> ignore
  main ()


わかりやすい。これならHaskellな人にも怒られなさそうですｗ
コンピューテーション式(Computation Expressions)をつくったら、
こんな風にモナド則を満たしているかどうか確認するとよいですね(実際はもっと抽象化した方がいい)。
これでモナド則ももうこわくないでござる。


あわせて読みたい

モナド則を満たすべき理由 - HaHaHa!(old)
http://haskell.g.hatena.ne.jp/nobsun/20080928/p1


これは参考になる

*1:bind

F#でRxる。よく訓練されたF#erはコンピューテーション式をつくる。

プログラミング F#2.0 F# C#4.0 C# Rx LINQ リアクティブプログラミング WPF コンピューテーション式 非同期 NuGet

いにしえからの言い伝えによると、よく訓練されたF#erはコンピューテーション式をつくるそうです。


Select Many: Reactive Extensions’ Mother Of All Operators (Chaining).　お、SelectManyですね。
なるほどなるほど。計算を繋ぐもの。モナドですか。そこでコンピューテーション式(Computation expressions)ですねわかります。


リアクティブプログラミングでリア充
リアクティブプログラミングとは何か。「Reactive Programming」を直訳すると「反応的なプログラミング」です。
その名の通り、反応的に作用するようにプログラミングをすることです。よくわかりませんね。


具体的には、値(あるいは状態)を直接的に扱わないで、「時間とともに変化する値(状態)」と「振る舞い(behavior)」の関係性に着目して、
宣言的にプログラムを表現するパラダイム。あるいは、それを軸としたプログラミングスタイルです。
リアクティブプログラミングは、値(状態)やIO、あるいは時間に対する振る舞いをマッピングし、
計算の遅延や合成、差分適用、非同期処理の扱いなどに長けています。(.NETでは、Rx(Reactive Extensions for .NET)を利用するなどで実現できる。)
Functional Reactive Programming（FRP）は、これを関数型の世界に持ってきたものです*1。
リアクティブプログラミングは先進的で、アカデミックな雰囲気が強いので、少しとっつきにくい所もありますが、
理解して使いこなせるようになれば、未来は明るいです。藤本幸世もびっくりのモテキ到来も夢じゃないです(ギークにモテモテ的な意味で)。



Rx(Reactive Extensions for .NET)とは
Rx(Reactive Extensions for .NET)は、LINQ to Objectsの数学的な意味の双対で、LINQシーケンスベースに、非同期イベント処理などのリアクティブな記述を、
pushベース と pullベース の両面からサポートするリアクティブフレームワークです。
最近では、「NuGet(ぬげっと)」でお手軽に導入できるようにもなりましたし、Windows Phone 7に標準搭載もされました。
まだまだ国内の情報は少ないのですが、非常に便利で強力なフレームワークなので利用しない手はないです。
Rxの日本語情報に関しては、@neueccさんのブログの記事がもっとも充実していると思います。ステキです。助かります！


@neueccさんのRxカテゴリ - neue.cc
http://neue.cc/category/programming/rx



逆に考えるんだ。IEnumerableがpullなら、IObservableはpush

Rxを理解する最も簡単な方法のひとつは、おそらくIEnumerableとIObservableを比較してみることです。
以下の例は、短いIEnumerableシーケンス内のすべての奇数を見つけて出力するだけのシンプルなC#のコード。

var oddNumbers = Enumerable.Range(1, 10).Where(n => n % 2 == 1);
foreach (int n in oddNumbers)
{
    Console.WriteLine(n);
}

変数oddNumbersへ代入した時点では、まだ計算は評価されません。
foreachによってIEnumerableを展開するときにはじめて計算が行われます。
foreachが何をしてくれているかというと、実際は以下の糖衣構文です。

var enumerator = Enumerable.Range(1, 10).Where(n => n % 2 == 1).GetEnumerator();
while (enumerator.MoveNext())
{
    Console.WriteLine(enumerator.Current);
}

MoveNextメソッドの呼び出しは、その都度データを“引いています(pull)”。
IEnumerableは“pull”モデルな遅延評価です。



Rxを利用して同じ結果を得るには、例えば以下のように書きます。

var oddNumbers2 = Observable.Range(1, 10).Where(n => n % 2 == 1);
oddNumbers2.Subscribe(x => Console.WriteLine(x));

Rxを知らないで見た場合、ぱっと見何が起こったのかわかりませんが、
この方法でも同じ結果が得られます。


では、一体何がおこったのでしょう。
以下は、oddNumbers2がやっていることをイメージしやすい（？）ように、別の方法で実装してみた例です。
（oddNumbers2の糖衣構文ではありませんので注意してください）

var oddNumbers3 = Observable.CreateWithDisposable<int>(observer =>
    {
        var cancel = new CancellationTokenSource();
        foreach (var n in Enumerable.Range(1, 10))
        {
            if (!cancel.Token.IsCancellationRequested)
            {
                observer.OnNext(n); continue;
            }
            observer.OnCompleted();
            break;
        }
        return cancel;
    });
oddNumbers3.Where(n => n % 2 == 1).Subscribe(x => Console.WriteLine(x));


IObservableは、いわゆる「Observerパターン」の一種で、IEnumerableの動作を逆にして考えたものです。
ObservableがObserverの OnNextメソッドを呼び出すことは、すなわちIEnumerableに情報を与えるための yieldキーワード に相当します。
これは、Observableが、OnNextメソッドによって、Observerに対してデータを“押し出し(push)”ています。
また、IObservableがObserverの OnCompletedメソッドを呼び出すことは、
IEnumrableで、もうこれ以上データがないことを表す breakキーワード に相当します。ちょうど逆になっています。


さて、説明を試みようとしましたが、感覚的にしかわかっていないので、うまく説明できませんorz
難しいことはよくわかりませんが、IObservableは pushモデル なので、とっても良いものらしいです。
何が良いのかというと、イベントや非同期処理のハンドリングに役立つようです。
例えば、IObserverをマウスイベントにアタッチして、それらを非同期的に記録したり、LINQを利用して反復処理をすることができたり。
これすなわち、事実上のモナドであり、リアクティブプログラミングを可能にしているというわけです。*2


ご存知の方はご存知のとおり、Rxの向こう側には素晴らしい世界が広がっています。が、その学習コストは大きな負担になるかもしれません。
一般的にプログラムを書く場合というのは、プロアクティブ*3なスタイルが主流なので、パラダイムシフトにはそれなりの痛み*4を伴うことが予想されます。
しかしながら、学習コストに見合っただけのリターンがRxには必ずあります。勉強して損はしません。というかしないと損します。


F#でRxる

さて、C#でRxと戯れるのもよいのですが、C#だけRxと仲良しなのはずるい*5。
F#でリアクティブプログラミングがしたいんです。Functional Reactive Programming (FRP)がしたいんです。（｀・ω・´）


F#では、なんとEvent(イベント)がファーストクラスオブジェクトなのです（C#とは違うのだよC#とは）。
ですので、Rxに頼らずに素のままのF#でも、ある程度リアクティブプログラミングの実践が可能となっています。
ただし、基本的なこと（mapやfilterやmergeなど）はできるものの、できることには限りがあります。
Control.Event モジュール(F#)がサポートする内容は、Rxの充実具合に比べて、どうしても見劣りしてしまいます。
http://msdn.microsoft.com/ja-jp/library/ee340422.aspx


ということで、「F#でRxる(F#からRxを使う)」ことにしました。Rxも.NETですので、もちろんF#から扱うことができます。
当然そのまま利用することもできますが、F#は関数型のパラダイムを軸とした関数型言語でありますから、
リアクティブプログラミングに関しても、できることならFunctionalに扱いたいんです。それがF#erの性(saga)というものです。
非常に面倒くさいですが、Rxの関数郡*6をF#の関数でラップしてFRP可能にします。パフォーマンスのことは考えません(ｷﾘｯ


Rx.fs

namespace FSharp

module Rx =
  open System
  open System.Linq
  open System.Threading
  open System.Windows.Threading

  let asAction f = new System.Action(f)
  let doNothing = asAction (fun () -> ())

  /// Observable.Create
  let create f =
    Observable.Create<_>(fun x ->
        f x
        doNothing)

  let create2 f =
    let subscribe = Func<_,_>(fun x -> Action(f x))
    Observable.Create(subscribe)

  /// Observable.CreateWithDisposable
  let createWithDisposable f =
    let subscribe = Func<_,_>(f)
    Observable.CreateWithDisposable(subscribe)
  
  /// Observer.Create
  let createObserver next error completed =
    Observer.Create(Action<_>(next))
  let createObserver2 next error =
    Observer.Create(Action<_>(next), Action<exn>(error))
  let createObserver3 next completed =
    Observer.Create(Action<_>(next), Action(completed))
  let createObserver4 next error completed =
    Observer.Create(Action<_>(next), Action<exn>(error), Action(completed))

  /// Observable.FromEvent
  /// F#では、Event<_,_>.Publishがあるから、もしかしていらねんじゃね的な雰囲気もある…
  let fromEvent (event:IEvent<_,_>) = create (fun x -> event.Add x.OnNext)
  let fromEvent2<'TEventArgs when 'TEventArgs :> EventArgs> addHandler removeHandler =
    Observable.FromEvent(Action<EventHandler<'TEventArgs>>(addHandler), Action<EventHandler<'TEventArgs>>(removeHandler))
  let fromEvent3<'TEventArgs, 'TDelegate when 'TEventArgs :> EventArgs 
                                         and 'TDelegate :> MulticastDelegate> conversion addHandler removeHandler =
    Observable.FromEvent(Func<EventHandler<'TEventArgs>,'TDelegate>(conversion) ,Action<'TDelegate>(addHandler), Action<'TDelegate>(removeHandler))
  let fromEvent4 addHandler removeHandler =
    Observable.FromEvent(Action<EventHandler>(addHandler), Action<EventHandler>(removeHandler))
  let fromEvent5 (event:IEvent<_,_>) =
    Observable.FromEvent(event.AddHandler, event.RemoveHandler)
  let fromEvent6 (target:obj) name =
    Observable.FromEvent(target, name)

  /// Async<_>. から Observableを生成します。
  let fromAsync a = 
    { new IObservable<_> with
        member x.Subscribe(obserber) =
          if obserber = null then nullArg "IObserver<'T>"
          let cts = new CancellationTokenSource()
          let ao = async {
            try
              let! r = a
              obserber.OnNext(r)
              obserber.OnCompleted()
            with 
              e -> cts.Cancel ()
                   obserber.OnError(e)}

          Async.StartImmediate(ao, cts.Token)
          { new IDisposable with 
              member x.Dispose() = 
                let invoked = ref 0
                if Interlocked.CompareExchange(invoked, 1, 0) = 0 then
                  cts.Dispose () }
          }

  /// Observable.SelectMany
  let selectMany source (other:'TSource -> IObservable<'TResult>) = 
    Observable.SelectMany(source, other)
  let selectMany2 f source = 
    Observable.SelectMany(source, Func<_, IObservable<'TResult>>(f))
  let selectMany3 f source = 
    Observable.SelectMany(source, Func<_, seq<'TResult>>(f))
  let selectMany4 f g source = 
    Observable.SelectMany(source, Func<_,_>(f), Func<_,_,_>(g))

  /// Observable.Catch
  let catch f source =
    (source:IObservable<'T>).Catch(Func<_,_>(f))
  let catch2 first second =
    (second:IObservable<'T>).Catch((first:IObservable<'T>))
  let catch3 source =
    Observable.Catch(source) 

  /// Observable.Finally
  let performFinally f source = Observable.Finally(source, fun _ -> f())

  /// Observable.While
  let While f source = Observable.While(Func<_>(f), source)

  /// Observable.Empty
  let empty<'T> = Observable.Empty<'T>()   

  /// Observable.Using
  let using rs ru = 
    Observable.Using(Func<_>(rs), Func<_,_>(ru));

  /// Observable.Concat 
  let concat (first:IObservable<'TSource>) second = Observable.Concat(first, second)
  let concat2 (source:seq<IObservable<'TSource>>) = Observable.Concat(source)
  let concat3 (source:IObservable<IObservable<'TSource>>) = Observable.Concat(source)
  let concat4  (source:IObservable<'TSource>) = Observable.Concat(source)

  /// Observable.Return
  let oreturn x = Observable.Return(x)
  let oreturn2 s x = Observable.Return(x, s)

  /// Observable.ToEnumerable
  let toEnumerable source = 
    Observable.ToEnumerable(source)


  (* 激しく長いのでいろいろ省略　*)


  type IObservable<'T> with
    member this.Subscribe(next) = subscribe next this
    member this.Subscribe(next, error) = subscribeWithError next error this
    member this.Subscribe(next, error, completed) = subscribeAll next error completed this


うへぇ。なげーよ…（なのでいろいろ省略）。※下の方にSkyDriveへのリンクを追加しました。



よく訓練されたF#erはコンピューテーション式をつくる。

さて、いにしえからの言い伝えによると、よく訓練されたF#erはコンピューテーション式をつくるそうです。
コンピューテーション式についてイチから説明すると、とんでもなく長くなる（というかうまく説明できない）ので端折りますが、


@mzpさんのF#プログラマのためのMaybeモナド入門 - みずぴー日記
http://d.hatena.ne.jp/mzp/20110205/monad
あたりを参照すると、いい感じに雰囲気が感じられるかと思います。



冒頭でも書きましたが、Select Many: Reactive Extensions’ Mother Of All Operators (Chaining)ということで、
SelectManyはIObservableの計算を繋ぐものだよね、と。お、モナドですか？ そこでコンピューテーション式にご登場いただこうというわけです。


Rx.fsに追加で

  open System.Collections.Generic

  /// Observableコンピューテーション式
  type ObservableBuilder() =
    member this.Bind(x, f) = 
      f |> selectMany x
    member this.Return(x) = 
      oreturn x
    member this.ReturnFrom(x) = x
    member this.TryWith(a,b) = 
      catch a b
    member this.TryFinally(x, f) = 
      performFinally x f
    member this.Zero() = 
      empty
    member this.While(x,f) = 
      While f x
    member this.Using(f,g) =
      using f g 
    member this.Delay f = f () 
    member this.Combine(a,b) = 
      concat a b
    member this.For(inp,f) =
      inp |> toEnumerable |> For f 
    member this.Yield(x) = oreturn x
    member this.YieldFrom(x) = x

  let observable = new ObservableBuilder()


わーい、Observableコンピューテーション式ができたよー！
しんぷるいずべすと！


いくつかのサンプルコード

「F#でRxる」によるFRPなちょっとしたサンプルをいくつか(非同期ワークフローとの組み合わせもあり)。NUnitとFsUnitを使っています。



　


Test.fs
長すぎるので、こまかいサンプルを省略しました。

namespace FSharp.Rx.UT

open System
open System.Windows 
open System.Windows.Controls 

module Util = 
  open System.ComponentModel
  open Microsoft.FSharp.Quotations.Patterns

  type ViewModelBase () =
    let propertyChanged = DelegateEvent<PropertyChangedEventHandler>()
    let getPropertyName = function 
      | PropertyGet(expr,pi,_) -> pi.Name 
      | _ -> invalidOp "プロパティ名の取得に失敗"
    interface INotifyPropertyChanged with
      [<CLIEvent>]
      member this.PropertyChanged = propertyChanged.Publish
    member this.NotifyPropertyChanged propertyName = 
      propertyChanged.Trigger [|this; PropertyChangedEventArgs propertyName|]
    member this.NotifyPropertyChanged quotation = 
      quotation |> getPropertyName |> this.NotifyPropertyChanged

module Tests = 
  open Util
  open System
  open System.Windows.Input
  open System.ComponentModel

  type SampleViewModel () =
      inherit ViewModelBase()
      let mutable text = ""
      member this.Message
          with get () = text
          and set value = 
              text <- value
              this.NotifyPropertyChanged <@ this.Message @>

  type browseViewModel (address:string) =
      inherit ViewModelBase()
      let mutable _address = ""
      do _address <- address 
      member this.Address
          with get () = _address
          and set value = 
              _address <- value
              this.NotifyPropertyChanged <@ this.Address @>

  open System
  open System.Windows
  open System.Windows.Input
  open System.Windows.Controls
  open System.Windows.Shapes
  open System.Windows.Media
  open System.Xaml
  open System.IO
  open System.Text
  open System.Windows.Markup
  open System.Drawing
  open System.Windows.Forms 
  open System.Windows.Threading 
  open System.Windows.Media.Animation
  open Microsoft.FSharp.Core.Operators.Unchecked 
  open System.Linq
  open System.Reactive 
  open NUnit.Framework
  open FsUnit
  open FSharp
  open FSharp.Rx

  let parseXAML (xaml : string) = XamlReader.Parse(xaml)

  [<TestFixture>]
  type ``FSharp Rx selectMany`` () =
    [<Test>] 
    member test.``sample async RunSynchronously`` () =
      let r = ref 0 
      let _ = async {printfn "%d" 0; return 1} |> Async.RunSynchronously
                |> fun x -> async {printfn "%d" x; return x + 2} |> Async.RunSynchronously
                |> fun x -> async {printfn "%d" x; return x + 3} |> Async.RunSynchronously
                |> fun x -> async {r := x; printfn "%d,%s" x "owata"} |> Async.Start |> ignore

      // background wait
      Rx.bgWait (fun _ -> ()) DispatcherPriority.Background |> ignore
      !r |> should equal 6

    [<Test>] 
    member test.``selectMany01 standerd`` () =
      let r = ref 0 
      use hoge = Rx.fromAsync (async { printfn "%d" 0; return 1 })
              |> Rx.selectMany <| (fun x -> Rx.fromAsync (async { printfn "%d" x; return x + 2 }))
              |> Rx.selectMany <| (fun x -> Rx.fromAsync (async { printfn "%d" x; return x + 3 }))
              |> Rx.subscribe (fun x -> r := x; printfn "%d,%s" x "owata")
      !r |> should equal 6

    [<Test>] 
    member test.``selectMany02 Computation Expressions`` () =
      let r = ref 0
      use d = 
        observable {
          let! x = observable { printfn "%d" 0; return 1 }
          let! y = observable { printfn "%d" x; return x + 2 }
          let! z = observable { printfn "%d" y; return y + 3 }
          return z
        } |> Rx.subscribe (fun x -> r:=x; printfn "%d,%s" x "owata")
      !r |> should equal 6

    [<Test>] 
    member test.``selectMany03 Computation Expressions from async`` () =
      let r = ref 0
      use d = 
        observable {
          let! x = Rx.fromAsync (async { printfn "%d" 0; return 1 })
          let! y = Rx.fromAsync (async { printfn "%d" x; return x + 2 })
          let! z = Rx.fromAsync (async { printfn "%d" y; return y + 3 })
          return z
        } |> Rx.subscribe (fun x -> r:=x; printfn "%d,%s" x "owata")
      !r |> should equal 6

  [<TestFixture>]
  type ``FSharp Rx Computation Expressions`` () =
    [<Test>] 
    member test.``For01`` () =
      let r = ref 0
      use d = 
        observable {
          let x = Rx.fromAsync (async { return 1 })
          let y = Rx.fromAsync (async { return 2 })
          let z = Rx.fromAsync (async { return 3 })
          let a = x.Concat(y).Concat(z)

          for i in a do 
            printfn "%d" i 

          return! a
          } |> Rx.subscribe (fun x -> r:=!r+x; printfn "%d,%s" x "owata")
      !r |> should equal 6

    [<Test>] 
    member test.``For02 Yield`` () =
      let r = ref 0 
      use d = 
        observable {
          let! x = Rx.fromAsync (async { printfn "%d" 0; return 1 })
          let! y = Rx.fromAsync (async { printfn "%d" x; return x + 2 })
          let  z = Rx.fromAsync (async { printfn "%d" y; return y + 3})
          let! a = z
          for i in z -> (printfn "%d" i; a)
        } |> Rx.subscribe (fun x -> r:=x;printfn "%d,%s" x "owata")
      !r |> should equal 6

    [<Test>] 
    member test.``For03 YieldFrom`` () =
      let r = ref 0
      use d = 
        observable {
          let! x = Rx.fromAsync (async { printfn "%d" 0; return 1 })
          let! y = Rx.fromAsync (async { printfn "%d" x; return x + 2 })
          let  z = Rx.fromAsync (async { printfn "%d" y; return y + 3})
          for i in z do 
            printfn "%d" i
            yield! z
        } |> Rx.subscribe (fun x -> r:=x;printfn "%d,%s" x "owata")
      !r |> should equal 6

    [<Test>] 
    member test.``For04 YieldFrom`` () =
      let r = ref 0 
      use d = 
        observable {
          let x = Rx.fromAsync (async { return 1 })
          let y = Rx.fromAsync (async { return 2 })
          let z = Rx.fromAsync (async { return 3 })
          let a = x.Concat(y).Concat(z)
          for i in a do 
            printfn "%d" i
            yield! a
        } |> Rx.subscribe (fun x -> r:=!r+x;printfn "%d,%s" x "owata")
      !r |> should equal (6 * 3)

    (* 中略 *) 

    [<Test>] 
    [<STAThread>]
     member test.``WPF01 FSharpCube`` () = 
      let view =
        let xaml =
            @"<Window xmlns='http://schemas.microsoft.com/winfx/2006/xaml/presentation' 
              xmlns:x='http://schemas.microsoft.com/winfx/2006/xaml'
              xmlns:SampleControls='Sample'
              Title='F# Cube' Background='SkyBlue' Height='400' Width='600' WindowStartupLocation='CenterScreen'>
                      <DockPanel>
                      <Canvas Name='canvas' Background='Transparent'>
                      <Viewport3D Name='ao' ClipToBounds='True' Width='150' Height='150' Canvas.Left='210' Canvas.Top='110'>
                        <Viewport3D.Camera>
                        <PerspectiveCamera x:Name='myPerspectiveCamera' FarPlaneDistance='15' LookDirection='0,0,-1' UpDirection='0,1,0' NearPlaneDistance='1' Position='0,0,2.25' FieldOfView='70' />
                        </Viewport3D.Camera>
                        <ModelVisual3D>
                            <ModelVisual3D.Content>
                            <Model3DGroup>
                                <DirectionalLight Color='#F9F9F9' Direction='-0.5,-0.5,-0.5' />
                                <DirectionalLight Color='#F9F9F9' Direction='0.5,-0.5,-0.5' />
                                <GeometryModel3D>
                                    <GeometryModel3D.Geometry>
                                        <MeshGeometry3D TriangleIndices='0,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' Normals='0,0,-1 0,0,-1 0,0,-1 0,0,-1 0,0,-1 0,0,-1 0,0,1 0,0,1 0,0,1 0,0,1 0,0,1 0,0,1 0,-1,0 0,-1,0 0,-1,0 0,-1,0 0,-1,0 0,-1,0 1,0,0 1,0,0 1,0,0 1,0,0 1,0,0 1,0,0 0,1,0 0,1,0 0,1,0 0,1,0 0,1,0 0,1,0 -1,0,0 -1,0,0 -1,0,0 -1,0,0 -1,0,0 -1,0,0 ' TextureCoordinates='1,1 1,0 0,0 0,0 0,1 1,1 0,1 1,1 1,0 1,0 0,0 0,1 0,1 1,1 1,0 1,0 0,0 0,1 1,1 1,0 0,0 0,0 0,1 1,1 1,0 0,0 0,1 0,1 1,1 1,0 0,0 0,1 1,1 1,1 1,0 0,0 ' Positions='-0.5,-0.5,-0.5 -0.5,0.5,-0.5 0.5,0.5,-0.5 0.5,0.5,-0.5 0.5,-0.5,-0.5 -0.5,-0.5,-0.5 -0.5,-0.5,0.5 0.5,-0.5,0.5 0.5,0.5,0.5 0.5,0.5,0.5 -0.5,0.5,0.5 -0.5,-0.5,0.5 -0.5,-0.5,-0.5 0.5,-0.5,-0.5 0.5,-0.5,0.5 0.5,-0.5,0.5 -0.5,-0.5,0.5 -0.5,-0.5,-0.5 0.5,-0.5,-0.5 0.5,0.5,-0.5 0.5,0.5,0.5 0.5,0.5,0.5 0.5,-0.5,0.5 0.5,-0.5,-0.5 0.5,0.5,-0.5 -0.5,0.5,-0.5 -0.5,0.5,0.5 -0.5,0.5,0.5 0.5,0.5,0.5 0.5,0.5,-0.5 -0.5,0.5,-0.5 -0.5,-0.5,-0.5 -0.5,-0.5,0.5 -0.5,-0.5,0.5 -0.5,0.5,0.5 -0.5,0.5,-0.5 ' />
                                    </GeometryModel3D.Geometry>
                                    <GeometryModel3D.Transform>
                                        <RotateTransform3D>
                                            <RotateTransform3D.Rotation>
                                                <AxisAngleRotation3D x:Name='FSharpCube' Angle='0' Axis='1 0 1' />
                                            </RotateTransform3D.Rotation>
                                        </RotateTransform3D>
                                    </GeometryModel3D.Transform>
                                    <GeometryModel3D.Material>
                                        <DiffuseMaterial>
                                            <DiffuseMaterial.Brush>
                                                <VisualBrush>
                                                    <VisualBrush.Visual>
                                                    <TextBlock Text=' F#' Background='Gold' />
                                                    </VisualBrush.Visual>
                                                </VisualBrush>
                                            </DiffuseMaterial.Brush>
                                        </DiffuseMaterial>
                                    </GeometryModel3D.Material>
                                </GeometryModel3D>
                            </Model3DGroup>
                            </ModelVisual3D.Content>
                        </ModelVisual3D>
                        <Viewport3D.Triggers>
                        <EventTrigger RoutedEvent='Viewport3D.Loaded'>
                            <BeginStoryboard>
                                <Storyboard>
                                    <DoubleAnimation Name='anmRotary'
                                        Storyboard.TargetName='FSharpCube'
                                        Storyboard.TargetProperty='Angle'
                                        From='0' To='360'
                                        Duration='0:0:2'
                                        RepeatBehavior='Forever' />
                                </Storyboard>
                            </BeginStoryboard>
                        </EventTrigger>
                        </Viewport3D.Triggers>
                        <Viewport3D.RenderTransform>
                            <TranslateTransform X='0' Y='0' />
                        </Viewport3D.RenderTransform>
                        </Viewport3D>
                    </Canvas>
                </DockPanel>
            </Window> " |> parseXAML :?> Window

        let ao = xaml.FindName("ao") :?> Viewport3D
        let canvas = xaml.FindName("canvas") :?> Canvas
        let mouseMove = canvas.MouseMove |> Rx.fromEvent

        mouseMove
        |> Rx.map (fun e -> let mutable targetPoint = e.GetPosition(canvas)
                            targetPoint.X <- targetPoint.X - ao.ActualWidth / 2.
                            targetPoint.Y <- targetPoint.Y - ao.ActualHeight / 2.
                            let d = new Duration(TimeSpan.FromMilliseconds(4500.))
                            let mutable xAnimation = new DoubleAnimation()
                            xAnimation.To <- Nullable targetPoint.X 
                            xAnimation.Duration <- d
                            let mutable yAnimation = new DoubleAnimation()
                            yAnimation.To <- Nullable targetPoint.Y 
                            yAnimation.Duration <- d
                            ao.BeginAnimation(Canvas.LeftProperty, xAnimation, HandoffBehavior.Compose)
                            ao.BeginAnimation(Canvas.TopProperty, yAnimation, HandoffBehavior.Compose)
                            )
        |> Rx.catch (fun e -> printfn "%s" e.Message; Rx.never)
        |> Rx.subscribe (fun x -> x) |> ignore
        xaml

      let main() =
        (System.Windows.Application()).Run(view) |> ignore
      main()

    [<Test>] 
    [<STAThread>]
     member test.``WPF02 D&D`` () = 
      let view =
        let xaml =
            @"<Window
                xmlns='http://schemas.microsoft.com/winfx/2006/xaml/presentation'
                xmlns:x='http://schemas.microsoft.com/winfx/2006/xaml'
                Title='F#,Rx Sample' Height='250' Width='250'>
            <Canvas x:Name='canvas' Background='White'>
                <Ellipse Fill='Pink' Width='60' Height='60' Canvas.Left='50' Canvas.Top='35' Canvas.ZIndex='1'/>
                <Ellipse Fill='SkyBlue'  Width='60' Height='60' Canvas.Left='75' Canvas.Top='70'/>
                <TextBlock Canvas.Left='85' Canvas.Top='95' Text='{Binding Message}' />
            </Canvas>
        </Window>" |> parseXAML :?> Window

        let canvas = xaml.FindName("canvas") :?> Canvas
        let leftDown = canvas.MouseLeftButtonDown  |> Rx.fromEvent
        let leftUp   = canvas.MouseLeftButtonUp |> Rx.fromEvent
        let mouseMove = canvas.MouseMove |> Rx.fromEvent
        let mouseLeave = canvas.MouseLeave |> Rx.fromEvent

        leftDown
        |> Rx.map (fun e -> (e, mouseMove |> Rx.takeUntil leftUp |> Rx.takeUntil mouseLeave))
        |> Rx.filter (fun (e, _) -> e.Source.Equals(canvas) = false)
        |> Rx.map (fun (e, o) ->
                    let control = e.Source :?> UIElement
                    let location = (Canvas.GetLeft(control), Canvas.GetTop(control))
                    let pt1 = e.GetPosition(canvas)
                    o |> map (fun e -> let pt2 = e.GetPosition(canvas)
                                       (control, location, pt2 - pt1)))
        |> Rx.mergeAll
        |> Rx.subscribe (fun (ctl, (left,top), delta) -> Canvas.SetLeft(ctl, left + delta.X)
                                                         Canvas.SetTop(ctl, top + delta.Y)) |> ignore
        xaml

      let main() =
        view.DataContext <- SampleViewModel(Message="F# love")
        (System.Windows.Application()).Run(view) |> ignore
      main()

    [<Test>] 
    [<STAThread>]
     member test.``WPF03 Google Map Client`` () = 
      let view =
        let xaml = 
            @"<Window 
                xmlns='http://schemas.microsoft.com/winfx/2006/xaml/presentation'
		            xmlns:x='http://schemas.microsoft.com/winfx/2006/xaml'
            		xmlns:l='clr-namespace:FSharp.Rx.UT;assembly=FSharp.Rx.UT'
		            Title='Google Map Client' Height='600' Width='800' WindowStartupLocation='CenterScreen'>
	            <Grid Background='#ddd' >
		            <Grid.RowDefinitions>
			            <RowDefinition Height='Auto' />
			            <RowDefinition Height='*' />
		            </Grid.RowDefinitions>
		            <Grid Grid.Row='0'>
			            <Grid.ColumnDefinitions>
				            <ColumnDefinition Width='*' />
				            <ColumnDefinition Width='Auto' />
			            </Grid.ColumnDefinitions>
                        <TextBox Grid.Column='0' Name='txtSearch' Margin='8,8,4,8' Text='{Binding Address}' />
			            <Button Grid.Column='1' Name='btnSearch' Width='64' Margin='4,8,4,8'>search</Button>
		            </Grid>
		            <WebBrowser x:Name='browser' Grid.Row='1' Margin='8,0,8,8' />
	            </Grid>
            </Window>" |> parseXAML :?> Window

        let btnSearch = xaml.FindName("btnSearch") :?> System.Windows.Controls.Button
        let txtSearch = xaml.FindName("txtSearch") :?> System.Windows.Controls.TextBox
        let browser = xaml.FindName("browser") :?> System.Windows.Controls.WebBrowser 
        browser.Source <- new Uri(System.IO.Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "index.htm"))
        let btnOnClick = btnSearch.Click |> Rx.fromEvent 
        let txtOnKeyDown = txtSearch.KeyDown |> Rx.fromEvent 

        let search () = browser.InvokeScript("moveMap", txtSearch.Text)

        btnOnClick
        |> Rx.map (fun x -> search ())
        |> Rx.catch (fun e -> printfn "%s" e.Message; Rx.never)
        |> Rx.subscribe (fun x -> ()) |> ignore

        txtOnKeyDown
        |> Rx.filter (fun e -> e.Key = Key.Enter)
        |> Rx.map (fun x -> search())
        |> Rx.catch (fun e -> printfn "%s" e.Message; Rx.never)
        |> Rx.subscribe (fun x -> ()) |> ignore

        xaml

      let main() =
        let b = new browseViewModel("旭川駅" )
        view.DataContext <- b
        (System.Windows.Application()).Run(view) |> ignore
      main()
      
  // nunit-gui-runner
  let main () = NUnit.Gui.AppEntry.Main([|System.Windows.Forms.Application.ExecutablePath|]) |> ignore
  main ()


最近…、MVVMという宗教がこわいです＞＜


index.htm

<!DOCTYPE html>
<!-- saved from url=(0017)http://localhost/ -->
<html>
<head>
	<meta http-equiv="content-type" content="text/html; charset=utf-8"/>
	<title>Gppgle Map</title>
	<style type="text/css">
		html, body { height: 100%; margin:0px; }
		#mapCanvas { height: 100%; overflow:auto; }
	</style>
	<script type="text/javascript" src="http://maps.google.com/maps/api/js?sensor=false"></script>
	<script type="text/javascript">
		//<![CDATA[
	    var map;
	    var geo;
	    google.maps.event.addDomListener(window, 'load', function () {
	        var mapdiv = document.getElementById("mapCanvas");
	        var myOptions = { zoom: 17,
	            center: new google.maps.LatLng(43.763781, 142.358084),
	            mapTypeId: google.maps.MapTypeId.ROADMAP,
	            scaleControl: true
	        };
	        map = new google.maps.Map(mapdiv, myOptions);
	        geo = new google.maps.Geocoder();
	    });

	    function moveMap(address) {
	        if (geo) {
	            geo.geocode({ 'address': address },
                    function (results, status) {
                        map.setCenter(results[0].geometry.location);
                    });
	        }
	    }
		//]]>
	</script>
</head>
<body>
    <div id="mapCanvas"></div>
</body>
</html>


コードが長すぎてポストできなかったので、SkyDriveにupしました。
参照設定とかもろもろについては、よしなにお願いします。

FSharp.Rx.zip



あわせて読みたい
@neueccさんのRxカテゴリ - neue.cc
http://neue.cc/category/programming/rx

なぜリアクティブプログラミングは重要か。- Conceptual Contexture
http://d.hatena.ne.jp/pokarim/20101226

やさしいFunctional reactive programming（概要編）- maoeのブログ
http://d.hatena.ne.jp/maoe/20100109/1263059731

Functional Reactive Programming - NyaRuRuの日記
http://d.hatena.ne.jp/NyaRuRu/20080317/p1

リアクティブプログラミングが世界中のソフトウェア技術者の９５％に普及しないと考える理由と今後に対する期待 - おろかな日々
http://d.hatena.ne.jp/Rinta/20110103/p1

Rx + WCF RIA Services = 簡単?? via(非同期プログラミングは辛いよ) - かずきのBlog@Hatena
http://d.hatena.ne.jp/okazuki/20110113/1294922753



F#でRxしてFRPプログラマになってよ！

*1:具体的な説明でもよくわからない件

*2:RxはGUIのイベントにおいて強力な効果を発揮するため、Silverlight ToolkitやWindows Phone 7に含まれています。

*3:ニキビケア的な意味ではなく

*4:頭痛的な意味も含めて

*5:VB.NETでも普通に使えますが、ラムダ式がアレなので…つらいですね

*6:オーバーロード多すぎだろ…

モナディックなパーサ・コンビネータFParsecを使おう。てゆうかParsec(Haskell)のApplicativeスタイルがやばい。

F#2.0 F# FParsec Haskell Parsec モナド パーサ・コンビネータ 構文解析 正規表現

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は良い道具です。ご賞味あれ。

*1:FParsecもモナドだよとか言ったらその筋の人に怒られそうだけど、まぁ制限付モナドとして捉えるのは間違いじゃないんじゃないか

*2:便利だけど適用は割と難しい。主に学習コスト的な意味で。

*3:Parsec(Haskell)の場合だと、Eitherで返す

*4:「Real World Haskell」日本語翻訳版には、作用型解析という名前で紹介されています

C#からF#のクロージャを利用するには、こんな風にしたらいんじゃないの的サンプル

F#2.0 F# C# VB.NET TDD 書籍


　

実践 F# 関数型プログラミング入門

実践 F# 関数型プログラミング入門



まず、書籍のご紹介をさせていただきます。
荒井さん、いげ太さん共著の「実践 F# 関数型プログラミング入門 」が好評発売中です。
微力ながらレビュアーの一人としてご協力させていただきました。


基本的な文法からはじまり、関数型言語の特徴について丁寧に解説しています。
読者が新しい情報を順を追って少しずつ手に入れながら、徐々に成長していけるように配慮して構成されています。
F#に興味がある人はもちろん、はじめて関数型言語を勉強しようという方にもおすすめです！
お値段以上ニトリよろしくお買い得すぎるので、.NETerは全員買ったほうがいいと思います。まじで。



C#からF#のクロージャを利用するには

で、小ネタです。


「実践 F# 関数型プログラミング入門 」のコラム p331 F#と他の言語を組み合わせた開発を考える
に言及されているように、これからの.NET開発はF#とC#(VB.NET)を組み合わせた開発が
デファクトスタンダードとなっていくのだろうと思います（とてつもなく時間はかかりそうですが）。
実際、わたしは仕事でF#とC#を組み合わせたソフトウェア開発に今年から取り組んでいきます（やったね！）。
ということを考えた場合…、C#で作ったライブラリはF#から容易に呼び出したいし、F#で作ったライブラリはC#から容易に呼び出したいわけです。
そこで最もネックとなるのが、F#のクロージャを受け取る関数をC#から呼びだそうとする場合です。
System.Func<>は適切なFSharpFunc<_>型へ変換する必要があるからです。


「実践 F# 関数型プログラミング入門 」のコラム p317 C#からF#のクロージャを利用するには
に少し解説がありますが、具体的にはどうしたらよいのでしょうか。



以前書いた記事の中でわたしは、C#側からF#のクロージャを受け取る関数を呼び出すために以下のような関数をいくつか定義しました。

public static FSharpFunc<TArg1, TResult> ToFSharpFunc<TArg1, TResult>(this Func<TArg1, TResult> func)
{
    return FuncConvert.ToFSharpFunc(new Converter<TArg1, TResult>(func));
}

public static FSharpFunc<TArg,Unit> ToFSharpFunc<TArg>(this Action<TArg> action)
{
    return FuncConvert.ToFSharpFunc(action);
}


これらはいずれも引数が１つの場合に限られます。
引数が増えると、とんでもなく面倒くさいことになります以下のように。

public static FSharpFunc<TArg1, FSharpFunc<TArg2,TResult>> ToFSharpFunc<TArg1, TArg2, TResult>(this Func<TArg1,TArg2,TResult> func)
{
    Converter<TArg1, FSharpFunc<TArg2, TResult>> conv = value1 =>
        {
            return ToFSharpFunc<TArg2,TResult>(value2 => func(value1, value2));
        };
    return FSharpFunc<TArg1, FSharpFunc<TArg2, TResult>>.FromConverter(conv);
}


いやはや、実に「C#らしいコード(笑)」が好きな方が好きそうなコードですねｗ
T4などを用いるなどしてC#で実装するというのなら、別に止めたりはしませんが。
こんなにC#らしすぎるコードを大量に吐き出されても…、なんだかなーという気がします。
たぶん、F#で実装した方が素直です。


以下、F#側でSystem.Func<>からFSharpFunc<_>への変換を支援する関数の実装サンプルです。

namespace Microsoft.FSharp.Core
open System
open System.Linq.Expressions
open System.Runtime.CompilerServices 

[<Extension>]
module Util =
  type public CSharpFunc = 
    static member internal ToFSharpFunc<'a> (action:Action<'a>) = fun a -> action.Invoke(a)
    static member internal ToFSharpFunc<'a,'b> (action:Action<'a,'b>) = fun a b -> action.Invoke(a,b)
    static member internal ToFSharpFunc<'a,'b,'c> (action:Action<'a,'b,'c>) = fun a b c -> action.Invoke(a,b,c)
    static member internal ToFSharpFunc<'a,'b,'c,'d> (action:Action<'a,'b,'c,'d>) = fun a b c d -> action.Invoke(a,b,c,d)
    static member internal ToFSharpFunc<'a,'b,'c,'d,'e> (action:Action<'a,'b,'c,'d,'e>) = fun a b c d e -> action.Invoke(a,b,c,d,e)

    static member internal ToFSharpFunc<'a,'b> (func:Func<'a,'b>) = fun a -> func.Invoke(a)
    static member internal ToFSharpFunc<'a,'b,'c> (func:Func<'a,'b,'c>) = fun a b -> func.Invoke(a,b)
    static member internal ToFSharpFunc<'a,'b,'c,'d> (func:Func<'a,'b,'c,'d>) = fun a b c -> func.Invoke(a,b,c)
    static member internal ToFSharpFunc<'a,'b,'c,'d,'e> (func:Func<'a,'b,'c,'d,'e>) = fun a b c d -> func.Invoke(a,b,c,d)
    static member internal ToFSharpFunc<'a,'b,'c,'d,'e,'f> (func:Func<'a,'b,'c,'d,'e,'f>) = fun a b c d e -> func.Invoke(a,b,c,d,e)

  // Action -> FSharpFunc
  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let actionToFSharpFunc1<'TArg> (action:Action<'TArg>) = 
    action |> CSharpFunc.ToFSharpFunc

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let actionToFSharpFunc2<'TArg1, 'TArg2> (action:Action<'TArg1, 'TArg2>) = 
    action |> CSharpFunc.ToFSharpFunc

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let actionToFSharpFunc3<'TArg1, 'TArg2, 'TArg3> (action:Action<'TArg1, 'TArg2, 'TArg3>) = 
    action |> CSharpFunc.ToFSharpFunc

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let actionToFSharpFunc4<'TArg1, 'TArg2, 'TArg3, 'TArg4> (action:Action<'TArg1, 'TArg2, 'TArg3, 'TArg4>) = 
    action |> CSharpFunc.ToFSharpFunc

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let actionToFSharpFunc5<'TArg1, 'TArg2, 'TArg3, 'TArg4, 'TArg5> (action:Action<'TArg1, 'TArg2, 'TArg3, 'TArg4, 'TArg5>) = 
    action |> CSharpFunc.ToFSharpFunc

  // Expression<Action> -> FSharpFunc
  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let expressionActionToFSharpFunc1<'TArg> (eaction:Expression<Action<'TArg>>) = 
    eaction.Compile() |> CSharpFunc.ToFSharpFunc

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let expressionActionToFSharpFunc2<'TArg1, 'TArg2> (eaction:Expression<Action<'TArg1, 'TArg2>>) = 
    eaction.Compile() |> CSharpFunc.ToFSharpFunc

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let expressionActionToFSharpFunc3<'TArg1, 'TArg2, 'TArg3> (eaction:Expression<Action<'TArg1, 'TArg2, 'TArg3>>) = 
    eaction.Compile() |> CSharpFunc.ToFSharpFunc

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let expressionActionToFSharpFunc4<'TArg1, 'TArg2, 'TArg3, 'TArg4> (eaction:Expression<Action<'TArg1, 'TArg2, 'TArg3, 'TArg4>>) = 
    eaction.Compile() |> CSharpFunc.ToFSharpFunc

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let expressionActionToFSharpFunc5<'TArg1, 'TArg2, 'TArg3, 'TArg4, 'TArg5> (eaction:Expression<Action<'TArg1, 'TArg2, 'TArg3, 'TArg4, 'TArg5>>) = 
    eaction.Compile() |> CSharpFunc.ToFSharpFunc

  // Func -> FSharpFunc
  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let funcToFSharpFunc1<'TArg, 'TResult> (func:Func<'TArg, 'TResult>) = 
    func |> CSharpFunc.ToFSharpFunc

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let funcToFSharpFunc2<'TArg1, 'TArg2, 'TResult> (func:Func<'TArg1, 'TArg2, 'TResult>) = 
    func |> CSharpFunc.ToFSharpFunc

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let funcToFSharpFunc3<'TArg1, 'TArg2, 'TArg3, 'TResult> (func:Func<'TArg1, 'TArg2, 'TArg3, 'TResult>) = 
    func |> CSharpFunc.ToFSharpFunc

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let funcToFSharpFunc4<'TArg1, 'TArg2, 'TArg3, 'TArg4, 'TResult> (func:Func<'TArg1, 'TArg2, 'TArg3, 'TArg4, 'TResult>) = 
    func |> CSharpFunc.ToFSharpFunc 

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let funcToFSharpFunc5<'TArg1, 'TArg2, 'TArg3, 'TArg4, 'TArg5, 'TResult> (func:Func<'TArg1, 'TArg2, 'TArg3, 'TArg4, 'TArg5, 'TResult>) = 
    func |> CSharpFunc.ToFSharpFunc 

  // Expression<Func> -> FSharpFunc
  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let expressionFuncToFSharpFunc1<'TArg,'TResult> (efunc:Expression<Func<'TArg, 'TResult>>) = 
    efunc.Compile() |> CSharpFunc.ToFSharpFunc 

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let expressionFuncToFSharpFunc2<'TArg1, 'TArg2 ,'TResult> (efunc:Expression<Func<'TArg1, 'TArg2, 'TResult>>) = 
    efunc.Compile() |> CSharpFunc.ToFSharpFunc

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let expressionFuncToFSharpFunc3<'TArg1, 'TArg2, 'TArg3 ,'TResult> (efunc:Expression<Func<'TArg1, 'TArg2, 'TArg3, 'TResult>>) = 
    efunc.Compile() |> CSharpFunc.ToFSharpFunc

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let expressionFuncToFSharpFunc4<'TArg1, 'TArg2, 'TArg3, 'TArg4 ,'TResult> (efunc:Expression<Func<'TArg1, 'TArg2, 'TArg3, 'TArg4, 'TResult>>) = 
    efunc.Compile() |> CSharpFunc.ToFSharpFunc

  [<Extension>] 
  [<CompiledName("ToFSharpFunc")>]
  let expressionFuncToFSharpFunc5<'TArg1, 'TArg2, 'TArg3, 'TArg4, 'TArg5 ,'TResult> (efunc:Expression<Func<'TArg1, 'TArg2, 'TArg3, 'TArg4, 'TArg5, 'TResult>>) = 
    efunc.Compile() |> CSharpFunc.ToFSharpFunc

  // FSharpFunc -> Func
  [<Extension>] 
  [<CompiledName("ToFunc")>]
  let fsharpFuncToFunc1<'TArg, 'TResult,'c when 'c :> FSharpFunc<'TArg, 'TResult>> 
    (x: 'c ): ('TArg -> 'TResult) = 
    x.Invoke   

  [<Extension>] 
  [<CompiledName("ToFunc")>]
  let fsharpFuncToFunc2<'TArg1, 'TArg2, 'TResult,'c when 'c :> FSharpFunc<'TArg1, FSharpFunc<'TArg2, 'TResult>>> 
    (x: 'c ): ('TArg1 -> 'TArg2 -> 'TResult) = 
    fun a b -> x.Invoke(a).Invoke(b)

  [<Extension>] 
  [<CompiledName("ToFunc")>]
  let fsharpFuncToFunc3<'TArg1, 'TArg2, 'TArg3, 'TResult,'c when 'c :> FSharpFunc<'TArg1, FSharpFunc<'TArg2, FSharpFunc<'TArg3, 'TResult>>>> 
    (x: 'c ): ('TArg1 -> 'TArg2 -> 'TArg3 -> 'TResult) = 
    fun a b c -> x.Invoke(a).Invoke(b).Invoke(c)

  [<Extension>] 
  [<CompiledName("ToFunc")>]
  let fsharpFuncToFunc4<'TArg1, 'TArg2, 'TArg3, 'TArg4, 'TResult,'c when 'c :> FSharpFunc<'TArg1, FSharpFunc<'TArg2, FSharpFunc<'TArg3, FSharpFunc<'TArg4, 'TResult>>>>> 
    (x: 'c ): ('TArg1 -> 'TArg2 -> 'TArg3 -> 'TArg4 -> 'TResult) = 
    fun a b c d -> x.Invoke(a).Invoke(b).Invoke(c).Invoke(d)
 
  [<Extension>] 
  [<CompiledName("ToFunc")>]
  let fsharpFuncToFunc5<'TArg1, 'TArg2, 'TArg3, 'TArg4, 'TArg5, 'TResult,'c when 'c :> FSharpFunc<'TArg1, FSharpFunc<'TArg2, FSharpFunc<'TArg3, FSharpFunc<'TArg4, FSharpFunc<'TArg5, 'TResult>>>>>> 
    (x: 'c ): ('TArg1 -> 'TArg2 -> 'TArg3 -> 'TArg4 -> 'TArg5 -> 'TResult) = 
    fun a b c d e -> x.Invoke(a).Invoke(b).Invoke(c).Invoke(d).Invoke(e)

module Sample =

  let a1 a b = a b 
               b |> ignore
  let a2 a b c = a b c
                 c |> ignore
  let a3 a b c d = a b c d
                   d |> ignore
  let a4 a b c d e = a b c d e
                     e |> ignore
  let a5 a b c d e f = a b c d e f
                       f |> ignore

  let t1 a b = a b
  let t2 a b c = a b c
  let t3 a b c d = a b c d
  let t4 a b c d e = a b c d e
  let t5 a b c d e f = a b c d e f


まだまだ不足しているものがありますが、とりあえずということで。



一応、テスト駆動(TDD)でつくってみました

VS2010のテストで、C#からF#のクロージャを受け取る関数を呼び出して見ましょう。
拡張メソッドToFSharpFunc()だけでF#のクロージャに変換できるので、こりゃあ便利ですねー。

using System;
using Microsoft.VisualStudio.TestTools.UnitTesting;
using System.Linq.Expressions;
using Microsoft.FSharp.Core;

namespace TestProject1
{
    /// <summary>
    /// UnitTest1 の概要の説明
    /// </summary>
    [TestClass]
    public class UnitTest1
    {
        public UnitTest1() {}

        #region Action
        [TestMethod]
        public void a1()
        {
            var i = 0;
            Action<int> a = x => 
            {
                Console.WriteLine(x);
                i = 1;
            };

            Sample.a1(a.ToFSharpFunc(),3);
            Assert.AreEqual(i, 1);
        }

        [TestMethod]
        public void a2()
        {
            var i = 0;
            Action<int, int> a = (x,y) =>
            {
                Console.WriteLine("{0}:{1}",x,y);
                i = 1;
            };

            Sample.a2(a.ToFSharpFunc(),3,9);
            Assert.AreEqual(i, 1);
        }

        [TestMethod]
        public void a3()
        {
            var i = 0;
            Action<int, int, int> a = (x, y, z) =>
            {
                Console.WriteLine("{0}:{1}:{2}", x, y, z);
                i = 1;
            };

            Sample.a3(a.ToFSharpFunc(), 3, 9, 27);
            Assert.AreEqual(i, 1);
        }

        [TestMethod]
        public void a4()
        {
            var i = 0;
            Action<int, int, int, int> a = (x, y, z, b) =>
            {
                Console.WriteLine("{0}:{1}:{2}:{3}", x, y, z, b);
                i = 1;
            };

            Sample.a4(a.ToFSharpFunc(), 3, 9, 27, 12);
            Assert.AreEqual(i, 1);
        }

        [TestMethod]
        public void a5()
        {
            var i = 0;
            Action<int, int, int, int, int> a = (x, y, z, b, c) =>
            {
                Console.WriteLine("{0}:{1}:{2}:{3}:{4}", x, y, z, b, c);
                i = 1;
            };

            Sample.a5(a.ToFSharpFunc(), 3, 9, 27, 12,15);
            Assert.AreEqual(i, 1);
        }
        #endregion

        #region ExpressionAction
        [TestMethod]
        public void a1e()
        {
            Expression<Action<int>> a = x => 
                Console.WriteLine(x);
            Sample.a1(a.ToFSharpFunc(), 3);
        }

        [TestMethod]
        public void a2e()
        {
            Expression<Action<int, int>> a = (x, y) => 
                Console.WriteLine("{0}:{1}", x, y);
            Sample.a2(a.ToFSharpFunc(), 3, 9);
        }

        [TestMethod]
        public void a3e()
        {
            Expression<Action<int, int, int>> a = (x, y, z) =>
                Console.WriteLine("{0}:{1}:{2}", x, y, z);

            Sample.a3(a.ToFSharpFunc(), 3, 9, 27);
        }

        [TestMethod]
        public void a4e()
        {
            Expression<Action<int, int, int, int>> a = (x, y, z, b) =>
                Console.WriteLine("{0}:{1}:{2}:{3}", x, y, z, b);

            Sample.a4(a.ToFSharpFunc(), 3, 9, 27, 12);
        }

        [TestMethod]
        public void a5e()
        {
            Expression<Action<int, int, int, int, int>> a = (x, y, z, b, c) =>
                Console.WriteLine("{0}:{1}:{2}:{3}:{4}", x, y, z, b, c);

            Sample.a5(a.ToFSharpFunc(), 3, 9, 27, 12, 15);
        }
        #endregion

        #region Func
        [TestMethod]
        public void t1()
        {
            Func<int, int> f = x => x * 2;
            var result = Sample.t1(f.ToFSharpFunc(), 3);
            Assert.AreEqual(result,6);
        }

        [TestMethod]
        public void t2()
        {
            Func<int, int, int> f = (x, y) => x * 2 + y;
            var result = Sample.t2(f.ToFSharpFunc(), 3, 5);
            Assert.AreEqual(result, 11);
        }

        [TestMethod]
        public void t3()
        {
            Func<int, int, int, int> f = (x, y, z) => (x * 2 + y) / z;
            var result = Sample.t3(f.ToFSharpFunc(), 3, 6, 4);
            Assert.AreEqual(result, 3);
        }

        [TestMethod]
        public void t4()
        {
            Func<int, int, int, int, int> f = (x, y, z, a) => (x * 2 + y / z) % a;
            var result = Sample.t4(f.ToFSharpFunc(), 10, 8, 2, 5);
            Assert.AreEqual(result, 4);
        }

        [TestMethod]
        public void t5()
        {
            Func<int, int, int, int, int, int> f = (x, y, z, a, b) => (x + y + z + a) / b;
            var result = Sample.t5(f.ToFSharpFunc(), 3, 6, 4, 5, 2);
            Assert.AreEqual(result, 9);
        }
        #endregion

        #region ExpressionFunc 
        [TestMethod]
        public void t1e()
        {
            Expression<Func<int, int>> f = x => x * 2;
            var result = Sample.t1(f.ToFSharpFunc(), 3);
            Assert.AreEqual(result, 6);
        }


        [TestMethod]
        public void t2e()
        {
            Expression<Func<int, int, int>> f = (x, y) => x * 2 + y;
            var result = Sample.t2(f.ToFSharpFunc(), 3, 5);
            Assert.AreEqual(result, 11);
        }

        [TestMethod]
        public void t3e()
        {
            Expression<Func<int, int, int, int>> f = (x, y, z) => (x * 2 + y) / z;
            var result = Sample.t3(f.ToFSharpFunc(), 3, 6, 4);
            Assert.AreEqual(result, 3);
        }

        [TestMethod]
        public void t4e()
        {
            Expression<Func<int, int, int, int, int>> f = (x, y, z, a) => (x * 2 + y / z) % a;
            var result = Sample.t4(f.ToFSharpFunc(), 10, 8, 2, 5);
            Assert.AreEqual(result, 4);
        }

        [TestMethod]
        public void t5e()
        {
            Expression<Func<int, int, int, int, int, int>> f = (x, y, z, a, b) => (x + y + z + a) / b;
            var result = Sample.t5(f.ToFSharpFunc(), 3, 6, 4, 5, 2);
            Assert.AreEqual(result, 9);
        }
        #endregion

    }
}



ということで、今年はF#とC#の二刀流で頑張っていきまーす。

メモ〜化したりスマス。 Memoization and Tail Recursive Function

F#2.0 F# F# Advent Calendar jp 2010 メモ化 末尾再帰


のぶひささん(id:Nobuhisa)が、魔法的メモ化関数を書いてくださいました。
めもりんこ - (hatena (diary ’Nobuhisa))


非常にふつくしいので、ぜひご覧になってください。



このエントリは「F# Advent Calendar jp 2010」第16回のものです。

F# Advent Calendar jp 2010とは

のぶひささん(id:Nobuhisa)発案のF#を盛り上げるイベントです。
2010年のクリスマス(もしくは2010年いっぱい？)までに、
参加者が１日１つずつF#にまつわる記事をブログに書いていき、
年末年始はみんなでF#を楽しもう！というとってもナイスなイベントです。
F#に関係してる記事であれば、その内容に特にしばりはないということなので、どなたでも気軽に参加できます。
ふるってご参加ください。また、この機会にF#にぜひ触れてみてください。


F#でメモ化について考えてみる
メリークリスマス!ということで、「メモ〜化したりスマス」とか。冬ですね。
寒いですが、F#でメモ化について考えてみたいと思います。


メモ化とはプログラムを高速化するための最適化技法のひとつで、
関数呼び出しの引数をキーとして、関数の結果をキャッシュに保持しておき、
1度呼び出された関数が再度呼び出されたときに再計算をせずに、保持しておいた結果を再利用する手法です。
具体的には、キーと値のペアを保持しておくためのコレクション（あるいはテーブル）を用意し、
クロージャ内で、関数の結果が静的スコープ内で解決されるように実装するようなもののことをそう呼びます。


メモ化関数はとってもエコです。なかでもメモ化された再帰関数は、
自身を何度も呼び出すという再帰というその特徴から、大きなエコ効果を発揮します。
「計算機プログラムの構造と解釈」(SICP : Structure and Interpretation of Computer Programs）の
23ページの下の方に少しと、159ページの下の方あたりからメモｲﾋについて解説があります。
お手元にある方は、パラパラっとめくってチラリと確認してみるのもいいかもしれません。


任意の関数をメモ化する関数をつくる

F#による任意の関数をメモ化する関数の実装例です。

[<CompiledName("Memoize")>]
let memoize1 f = 
  let dic = Dictionary<'TArg1, 'TResult> ()  
  fun x -> match dic.TryGetValue(x) with 
           | true, r -> r
           | _       -> dic.[x] <- f x
                        dic.[x]


ご覧いただくとわかるように、Dictionary内のキーに引数が存在した場合はDictionaryから取得した値を返し、
存在しなかった場合は、関数に引数を適用した結果を辞書に登録してから、結果を返しています。
これがF#におけるメモ化の基本的な実装例です。
(F#であれば「ref Map.empty」を使うなんてもことも考えられますが、何か美しくないんですよねこれ。どっちがよいのかな。)



ちなみに、この関数の型はこんな感じになっています。


あれれ、これでは引数を１つ取る任意の関数についてしかメモ化することができませんね。
引数を２つ、あるいは３つ取る任意の関数もメモ化したいのに。


２つあるいは３つの引数を取る任意の関数をメモ化する関数をつくる

作りました。

[<CompiledName("Memoize")>]
let memoize2 f = 
  let dic = createDic (defaultof<'TArg1> 
                     , defaultof<'TArg2>) defaultof<'TResult>
  fun x y -> match dic.TryGetValue((x,y)) with 
             |true, r -> r
             | _      -> dic.[(x,y)] <- f x y
                         dic.[(x,y)]


「１つの引数を取る任意の関数をメモ化する関数」と似ていますね。
ところで、「createDic」とはなんでしょう。これです。

let createDic (key:'a) (value:'b) = Dictionary<'a, 'b> ()


引数で与えられたkeyとvalueの型を適用したDictionaryを作ります。
この関数を利用することで、Unchecked.defaultof<'T>を用いて、
任意のジェネリックなDictionaryをクリエイトしているというわけです。
ここでは('TArg1, 'TArg2)のタプルをkeyとして、'TResultをvalueとするDictionaryが作られています。
他は、１つの引数を取るバージョンと一緒ですね。
これを刺身タンポポの要領でコピペしていけば、３引数バージョン、４引数バージョン・・・と容易に量産することができます*1。


[<CompiledName("Memoize")>]
let memoize3 f = 
  let dic = createDic (defaultof<'TArg1> 
                     , defaultof<'TArg2>
                     , defaultof<'TArg3>) defaultof<'TResult>
  fun x y z -> match dic.TryGetValue((x,y,z)) with 
               |true, r -> r
               | _      -> dic.[(x,y,z)] <- f x y z
                           dic.[(x,y,z)]

まぁ、必要となるのはせいぜい３引数バージョンまででしょう。
「引数多すぎは百害あって一利なし」って、ことわざにもあるくらいです。



関数型言語だからこそDRY原則*2を意識して

ここまでのメモ化関数の中に、似たような実装が複数あらわれましたね。（コピペ駆動開発の賜物）
これは不吉な臭いを感じますね？そんなときはリファクタリングだね？


やってみましょう。
まず、せっかくなので１引数バージョンについてもcreateDicを使うようにしてみましょう。

[<CompiledName("Memoize")>]
let memoize1 f = 
  let dic = createDic  defaultof<'TArg1> defaultof<'TResult>
  fun x -> match dic.TryGetValue(x) with 
           | true, r -> r
           | _       -> dic.[x] <- f x
                        dic.[x]

なんだか少しかっこよくなりましたね。気のせいですね。



２引数バージョンをリファクタったー。

type args<'TArg1,'TArg2> = {item1:'TArg1; item2:'TArg2}
[<CompiledName("Memoize")>]
let memoize2 (f : 'TArg1 -> 'TArg2 -> 'TResult) = 
  let f' = collateArg { item1 = defaultof<'TArg1>
                        item2 = defaultof<'TArg2> } (fun a -> f a.item1 a.item2) |> memoize1
  fun a b -> f' { item1 = a 
                  item2 = b}


なんだか、ずいぶんと様変わりしましたね。少しずつ見ていきましょう。
まずはcollateArg関数です。名前むつかしいです。なんとなく雰囲気で付けました。

let collateArg (arg: 'TArg) (f : 'TArg -> 'TResult) = fun a -> f a


引数をまとめるみたいな感じですね。型はこんな感じになっています。


次に、type args<'TArg1,'TArg2>ですが、これはレコード型です。
F#では、C#でいうところの匿名型にあたるものの代用としてレコード型を用いることがあります。
レコード型はimmutableなValueObjectとみなすことができるので、そいつをうまく利用したわけです。
２つの引数をまとめたimuutableなValueObjectをキーとしてDictionaryに登録することで
１引数バージョンのmemoize1関数の実装を、２引数バージョンで再利用することができました。


同じ要領で３引数バージョンもつくっちゃいましょう。

type args<'TArg1,'TArg2,'TArg3> ={item1:'TArg1; item2:'TArg2; item3:'TArg3}
[<CompiledName("Memoize")>]
let memoize3 (f : 'TArg1 -> 'TArg2 -> 'TArg3 -> 'TResult) = 
  let f' = collateArg { item1 = defaultof<'TArg1>
                        item2 = defaultof<'TArg2>
                        item3 = defaultof<'TArg3> } (fun a -> f a.item1 a.item2 a.item3) |> memoize1
  fun a b c -> f' { item1 = a 
                    item2 = b
                    item3 = c}


ふつくしい…。


おまけ１：引数なし関数のメモ化

一応、引数なし関数というか、unitを引数として取る関数のメモｲﾋについても考えておきましょう。
あんまりうれしい関数ではないけれど。

[<CompiledName("Memoize")>]
let memoize0 f = 
  let value = ref defaultof<'TResult>
  let hasValue = ref false
  fun () -> if not !hasValue then  hasValue := true
                                   value := f ()
            !value

Dictionaryを利用していないという点で異なるだけであって、基本はなにも変わっていません。
メモ化の考え方を理解していれば、容易に理解できる内容ですね。



まだもう少し続きます。お付き合いください。

*1:かの有名な、コピペ駆動開発。

*2:"Don't Repeat Yourself." 繰り返しの禁止

続きを読む