ようこそ。睡眠不足なプログラマのチラ裏です。

F#で逆FizzBuzz問題

元ネタ
FizzBuzz問題 (Inverse FizzBuzz) - 猫とC#について書くmatarilloの雑記
http://d.hatena.ne.jp/matarillo/20120515/p1

 

面白いですねえ。




無理矢理詰め込んでツイートしたけど、F#で140文字ゴルフプログラミングとか割と無茶ですから!(白目

F#で逆FizzBuzz問題

二番煎じというのは、面白さ半減どころかほぼ面白みなし!的な雰囲気がありますが、
ゴルフなスニペットだけ置いておくのもアレなので実装例全体をのっけとく。

open System

let fzbz lst = 
  let isFizzBuzz x = if x%3 = 0 || x%5 =0 then true else false
  let toFizzBuzz x = 
    (x%3,x%5) |> function
    |0,0 -> "fizzbuzz"
    |0,_ -> "fizz" 
    |_ -> "buzz"
  [for x in lst do if isFizzBuzz(x) then yield toFizzBuzz(x)]

let range n = [1..n] |> List.map (fun x -> [x..n] |> List.map (fun y -> x,y)) |> List.collect id
                     |> List.sortBy (fun (a,b) -> b - a) 
let inverses x = range 100 |> List.find (fun (a,b) -> fzbz [a..b] = x)

printfn "%A" <| inverses ["fizz"]               // (3,3)
printfn "%A" <| inverses ["buzz"]               // (5,5)
printfn "%A" <| inverses ["fizz";"fizz";"buzz"] // (6,10)
printfn "%A" <| inverses ["fizz";"buzz"]        // (9,10)
printfn "%A" <| inverses ["buzz";"fizz"]        // (5,6)
printfn "%A" <| inverses ["fizz";"buzz";"fizz"] // (3,6)
printfn "%A" <| inverses ["fizz";"fizz"]        // (6,9)
printfn "%A" <| inverses ["fizz";"fizzbuzz"]    // (12,15)

Console.ReadLine () |> ignore

元ネタの元ネタのScalaでの解説は、確かにストーリー的には面白いものになっているけど、プログラムとしては結構無駄な計算が多くて、それってどうなの?ってー感じがしないこともなくもない。上記のように、探索対象を範囲が狭くて小さい順に先にソートしてから探索して、最初に一致したものを返すという考え方の方が、計算量も少なくなりますし自然ですね。


 
いげ太さんに禿同と言わざるを得ない。まぁ、抽象化の超パワーを無視することは(おれは)できないけどね!
ちなみに、F#は書き味のほうも最高峰レベルなので使ったら気に入ること間違いなしだよっウフフオッケー☆





追記:5/17
対象が見つからない場合も考慮したやつ

open System

let fzbz lst = 
  let isFizzBuzz x = if x%3 = 0 || x%5 =0 then true else false
  let toFizzBuzz x = 
    (x%3,x%5) |> function
    |0,0 -> "fizzbuzz"
    |0,_ -> "fizz" 
    |_ -> "buzz"
  [for x in lst do if isFizzBuzz(x) then yield toFizzBuzz(x)]

let range n = [1..n] |> List.map (fun x -> [x..n] |> List.map (fun y -> x,y)) |> List.collect id
                     |> List.sortBy (fun (a,b) -> b - a) 
let inverses = function
| [] -> None
| x  -> range 100 |> List.tryFind (fun (a,b) -> fzbz [a..b] = x)

let print = function
| Some x -> printfn "%A" <| x
| None   -> printfn "None"

print <| inverses ["fizz"]                // (3,3)
print <| inverses ["buzz"]                // (5,5)
print <| inverses ["fizz";"fizz";"buzz"]  // (6,10)
print <| inverses ["fizz";"buzz"]         // (9,10)
print <| inverses ["buzz";"fizz"]         // (5,6)
print <| inverses ["fizz";"buzz";"fizz"]  // (3,6)
print <| inverses ["fizz";"fizz"]         // (6,9)
print <| inverses ["fizz";"fizzbuzz"]     // (12,15)
print <| inverses []                      // None
print <| inverses ["orz"]                 // None
print <| inverses ["fizzbuzz";"fizzbuzz"] // None

Console.ReadLine () |> ignore

観たやつ

#737. カフーを待ちわびて
#738. ゴージャス
#739. サイダーハウスルール
#740. ビッグリバー
#741. DOCUMENTARY of AKB48 to be continue
#742. ICHI
#743. シーズンチケット
#744. ポリスアカデミー
#745. モールス
#746. ランダムハーツ
#747. ドラえもん 新・のび太と鉄人兵団 〜はばたけ 天使たち〜
#748. 第9地区
#749. ブレイド3
#750. シャーロックホームズ
#751. 悪霊島
#752. ルパン三世 VS 名探偵コナン
#753. 闘茶 TeaFight
#754. キューティーバニィ
#755. アルファ・ドッグ 破滅へのカウントダウン
#756. ヴァイラス
#757. RONIN
#758. イルマーレ
#759. 落語娘
#760. 新少林寺
#761. ライオンキング
#762. ネバーサレンダー肉弾凶器
#763. マーサの幸せレシピ
#764. 名探偵コナン 沈黙のクォーター
#765. Mr. & Mrs スミス
#766. ハートブレイカー
#767. キッズリターン
#768. わたし出すわ
#769. タイタンの戦い
#770. いぬばか
#771. スリーリバーズ
#772. 毎日かあさん
#773. SPACE BATTLESHIP ヤマト
#774. 破線のマリス
#775. 恋と花火と観覧車
#776. バッテリー
#777. あしたの私のつくりかた
#778. ACRI
#779. ジュエルに気をつけろ
#780. 酔いどれ詩人になる前に
#781. ボクのおじさんn
#782. あずみ2
#783. K-20 怪人二十面相・伝
#784. シェイディグローヴ
#785. 猟奇的な彼女 in NY
#786. アンダーワールド
#787. インタービューウィズヴァンパイア

F#で簡素なモゲマスコンプガチャシミュレータ

椎名林檎自由へ道連れ」をヘビロテしすぎて脳内無限ループしている今日この頃ですが、皆様いかがお過ごしでしょうか。
時事ネタとしては旬を逃した感じですが、簡素なコンプガチャシミュレータをF#で書いてみました。



とは言っても、この記事で伝えたいことはコンプガチャの確率がどうのですとか、実社会におけるコンプガチャの問題点がどうのとかいうような話題を扱うものではなく、安直にモナド則を満たさないコンピューテーション式を作ってしまうよりかは、Identityモナド(恒等モナド)を使ってプログラミングをした方が、見通しが良くモジュール性の高いコードを書くことができるかもしれないよ、という話題を提供します。割とどうでもいい話題ですね。未だガラケーユーザーであり、スマホやソーシャルゲーとはほとんど縁のない私ですが(もちろんモゲマスもやったことない)、気が向いたのでちょっと書いてみました。なお、モゲマスおよびFSharpxのステマではありません。


シミュレートするコンプガチャの仕様

まずはシミュレートするコンプガチャの仕様について簡単に確認しておきましょう。今回実装してみるのは、モゲマスことモバゲー『アイドルマスター シンデレラガールズ』のコンプガチャ「パジャマパーティー」に近いコンプガチャのシミュレートを目的としてみます。




Google先生に聞いてきた モゲマス 「パジャマパーティー」コンプガチャの概要

時折行われる課金ガチャのイベント企画。1ガチャあたり300円を支払って利用するガチャです。1回に1枚のアイドルカードが得られます。実際の支払いは「モバコイン」ですが、モバコインは100G=100円で購入して利用するため、便宜上こちらではそのまま円とします。イベント期間中以下の「レア」パジャマアイドルが確率テーブルに5枚追加され、その5枚を全て集めると、特典として限定「Sレア」カード「[眠れる姫君]星井美希」を獲得できるというもの。


コンプ対象パジャマアイドル
・[パジャマパーティー]緒方智絵里 コスト12 攻2880 守1600 キュート攻中アップ
・[パジャマパーティー]間中美里 コスト08 攻1240 守1440
・[パジャマパーティー]黒川千秋 コスト10 攻1860 守1560 クール攻中アップ
・[パジャマパーティー]川島瑞樹 コスト09 攻1400 守1680
・[パジャマパーティー]若林智香 コスト12 攻1600 守2680 パッション守中アップ



なお、バンナムによる公式の発表はないが、いずれかのパジャマアイドルが出現する確率は12%程度とのこと。
  
※ガチャのセット販売も行われているが、ここでは1回ずつガチャを行うこととする。
※なお、ネットで適当に拾ってきた情報のため正確ではない可能性あり。

内部の実装の詳細はわかりませんが、「今すぐモゲマスPすべてにSレアを授けてみせろッ! ver. 0.141.33」というシミュレータが既にあるようです。
http://mugenmasakazu.plala.jp/cgi-bin/nijiuraIDOLMASTER/mogemaskillyourself.cgi



なお、コンプガチャがどうして危険と言われているのかの理由については、「コンプガチャの確率マジックを中学生にも分かるように説明するよ - てっく煮ブログ」の解説がわかりやすい。わたしが中学生にも分かるように説明するなら、例えばモンハンの素材であるところの「逆鱗(出現率2%)」が5種類あったとして、それらすべてを揃えないと作れない武器があったとき、それにかかる時間を想像してみると、コンプガチャへ挑む無謀さが割と想像しやすい、とか。欲しいと思う素材ほど出ないようになっているといわれる架空のシステム。いわゆる「センサー」の存在への疑い、とか。



簡素なコンプガチャシミュレータを愚直に書いてみる

まずは愚直に。細かいことは考えずにとりあえず実装してみたバージョン。

open System

let tee x f = f x; x
let (|>!) x f= tee x f

let rand = new Random(DateTime.Now.Millisecond);

type Rarity = 
  |R of string 
  |Other

// ガチャアイテム
let a,b,c,d,e,other = R("緒方智絵里"), R("間中美里"), R("黒川千秋"), R("川島瑞樹"), R("若林智香"), Other

// コンプ
let comp = [a;b;c;d;e]

// コンプ対象が出る確率
let probability = 0.12

let shuffle source =
  let array = List.toArray source
  let rec loop i =
    i |> function
    | 1 -> ()
    | _ ->
      let i =  i - 1
      let j = rand.Next(i)
      let temp = array.[i]
      array.[i] <- array.[j]
      array.[j] <- temp;
      loop i
  loop source.Length
  [for x in array do yield x]

let completeGacha lst count total =
  let items = 
    let dummy p = 
      let e = ((float comp.Length) / p) |> int
      [for i in 1..(e-comp.Length)  do yield Other]
    let target = comp@dummy probability 
    target |> shuffle

  let gacha () = rand.Next(1, items.Length) |> fun i -> items.[i]

  let rec gacha' count total =
    let newitem = gacha ()
    let current = count + 1
    if List.exists (fun x -> x = newitem) comp |> not then
      (* でねぇ!!!*)
      gacha' current total
    elif List.forall (fun x -> x = newitem |> not) lst |> not then
      (* ダブりかよ...orz *)
      gacha' current total
    else
      (* よっしゃー!なんという引きの良さ!!! *)
      lst@[newitem], current, (total + current), List.length (lst@[newitem]) = comp.Length
  gacha' count total

let printGacha x = 
  x |>! (fun (possession, n, total, complete) -> 
          let g = sprintf "%d回:%d円 " n (300 * n)
          let sum = sprintf "合計%d円" (300 * total)
          let result = sprintf "%s" (if complete then "コンプ" else "未コンプ")
          printfn "%s %s %A %s" g sum possession result)
  
let cut (a,b,c,d) = a,b,c

completeGacha [] 0 0 |> printGacha |> cut
|||> completeGacha |> printGacha |> cut
|||> completeGacha |> printGacha |> cut
|||> completeGacha |> printGacha |> cut
|||> completeGacha |> printGacha |> cut
|> fun _ -> printfn "[眠れる姫君]星井美希を手に入れた!" 

Console.ReadLine () |> ignore


ジェネリックもへったくれもない。いくら適当とはいえ愚直すぎて泣ける。



結果は当然実行ごとに毎回変わりますが、一応実行結果の例。

1回:300円  合計300円 [R "黒川千秋"] 未コンプ
8回:2400円  合計2700円 [R "黒川千秋"; R "緒方智絵里"] 未コンプ
38回:11400円  合計14100円 [R "黒川千秋"; R "緒方智絵里"; R "川島瑞樹"] 未コンプ
78回:23400円  合計37500円 [R "黒川千秋"; R "緒方智絵里"; R "川島瑞樹"; R "間中美里"] 未コンプ
108回:32400円  合計69900円 [R "黒川千秋"; R "緒方智絵里"; R "川島瑞樹"; R "間中美里"; R "若林智香"] コンプ
[眠れる姫君]星井美希を手に入れた!

1回目でレアカード"黒川千秋"を引き当てるという強運を発揮するも、2枚目のレア"緒方智絵里"を引き当てるには8回かかる。
そして、あらあらまあまあ最終的には合計69900円のぶっこみ。バンナムにかなり貢ぎましたな。



簡素なコンプガチャシミュレータをコンピューテーション式で

愚直にもほどがあるので、もうちょっとなんとかしてみましょう。

completeGacha [] 0 0 |> printGacha |> cut
|||> completeGacha |> printGacha |> cut
|||> completeGacha |> printGacha |> cut
|||> completeGacha |> printGacha |> cut
|||> completeGacha |> printGacha |> cut
|> fun _ -> printfn "[眠れる姫君]星井美希を手に入れた!" 

上記部分に着目すると、なんだか順々に関数を適用していく流れが見えます。なんだかコンピューテーション式にできそうです。
ということで、とりあえずコンピューテーション式にしてみる。

namespace Library1

[<AutoOpen>]
module CompleteGacha =
  open System

  let tee x f = f x; x
  let inline (|>!) x f= tee x f

  let rand = new Random(DateTime.Now.Millisecond);
  let shuffle source =
    let array = List.toArray source
    let rec loop i =
      i |> function
      | 1 -> ()
      | _ ->
        let i =  i - 1
        let j = rand.Next(i)
        let temp = array.[i]
        array.[i] <- array.[j]
        array.[j] <- temp;
        loop i
    loop (List.length source)
    [for x in array do yield x]

  let completeGacha comp d probability (lst:'a list) count total =
    let items = 
      let dummy p = 
        let e = ((float <| List.length comp) / p) |> int
        [for i in 1..(e - (List.length comp)) do yield d]
      let target = comp@(dummy probability)
      target |> shuffle

    let gacha () = 
      let i = rand.Next(1, (List.length items)) 
      items.[i]

    let rec gacha' count total =
      let newitem = gacha ()
      let current = count + 1
      if List.exists (fun x -> x = newitem) comp |> not then
        (* でねぇ!!! *)
        gacha' current total
      elif List.forall (fun x -> x = newitem |> not) lst |> not then
        (* ダブりかよ...orz *)
        gacha' current total
      else
        (* よっしゃー!なんという引きの良さ!!! *)
        lst@[newitem], current, (total + current), List.length (lst@[newitem]) = List.length comp
    gacha' count total

  type CompGacha<'a> = CompGacha of 'a 

  type CompGachaBuilder () =
    member this.Bind(m, f) : CompGacha<_> = 
      let (CompGacha (comp, d, p, lst,count,total,complete)) = m
      let lst,count,total,complete = completeGacha comp d p lst count total 
      f (comp,d, p, lst,count,total,complete)
    member this.Return x = CompGacha(x)
    member this.ReturnFrom x = x

  let cg = new CompGachaBuilder()

  let printGacha price unit f x = 
    x |>! (fun (comp, d, p, possession, n, total, complete) -> 
            let g = sprintf "%d回:%d%s" n (price * n) unit
            let sum = sprintf "合計%d%s" (price * total) unit
            let result = sprintf "%s" (if complete then "コンプ" else "未コンプ")
            printfn "%s %s %A %s" g sum possession result
            if List.length comp = List.length possession then 
              f())

  open FSharpx
  open Operators
  let inline returnM x = returnM cg x 
  let inline (>>=) m f = bindM cg m f
  let inline (=<<) f m = bindM cg m f
  let inline ap m f = f <*> m
  let inline map f m = liftM cg f m
  let inline (<!>) f m = map f m
  let inline lift2 f a b = returnM f <*> a <*> b
  let inline (>>.) m f = bindM cg m (fun _ -> f)
  let inline (>=>) f g = fun x -> f x >>= g
  let inline (<=<) x = flip (>=>) x

利用側

open System
open Library1

type Rarity = 
  |R of string 
  |Other

// ガチャアイテム
let a,b,c,d,e,other = R("緒方智絵里"), R("間中美里"), R("黒川千秋"), R("川島瑞樹"), R("若林智香"), Other

// コンプ
let comp = [a;b;c;d;e]

// コンプ対象アイテムが出る確率
let probability = 0.12 // 12%

// 1ガチャあたり300let printg = printGacha 300 "円" (fun () -> printfn "[眠れる姫君]星井美希を手に入れた!") 

let mogemasu x = 
  cg { return x } 
  >>= fun x -> cg { return x |> printg } 
  >>= fun x -> cg { return x |> printg } 
  >>= fun x -> cg { return x |> printg } 
  >>= fun x -> cg { return x |> printg } 
  >>= fun x -> cg { return x |> printg } 

// 別の書き方
//let mogemasu x = 
//  cg { let! x = cg { return x } 
//       let! x = cg { return x |> printg } 
//       let! x = cg { return x |> printg } 
//       let! x = cg { return x |> printg } 
//       let! x = cg { return x |> printg } 
//       return x |> printg }

(comp, other, probability, [], 0, 0, false) |> mogemasu |> ignore
Console.ReadLine () |> ignore

とりあえずコンピューテーション式にしました以外の何物でもない。愚直版に比べるとそこそこ抽象化こそされているが、まだ不十分。コンプ対象カード中何枚揃えるまでガチャを行うかの部分がハードコーディングされている(この場合は5回のBindをすることで5枚揃えるまでガチャしている)。ちなみに、このコンピューテーション式は「Functor且つApplicative且つモナド」を満たさない。「コンピューテーション式がモナドである必要は必ずしもない」が、このような実装ではモジュール性の低下は否めない。



簡素なコンプガチャシミュレータをIdentityモナド

HaskellでIdentityモナド(恒等モナド)と言えば、一般的にはモナド変換子からモナドを導出するために使われることで知られている。内部処理を伴わない単なる関数適用をモナドで表現する目的でIdentityモナドを使うことは、Haskellではあまりしないのかもしれない。しかし、まったく意味がないというわけではない。モナドを利用することで、モジュール性が高まりプログラムの見通しが良くなる。「Functor且つApplicative且つモナド」ではないコンピューテーション式をわざわざ作るよりかは、Identityモナドを使った実装の方が見通しの良いプログラムが書けるかもしれない。



ではやってみよう。
FSharpxには標準で実装されていないため、まずはIdentityモナドをつくる必要がある。

module Identity =
  type M<'T> = M of 'T 
  let mreturn x : M<'T> = M x

  type IdentityBuilder () =
    member this.Return (x) = mreturn x
    member this.Bind ((M x),f) : M<'U> = f x

  let identity = IdentityBuilder ()

  open FSharpx
  open Operators
  let inline returnM x = returnM identity x 
  let inline (>>=) m f = bindM identity m f
  let inline (=<<) f m = bindM identity m f
  let inline (<*>) f m = applyM identity identity f m
  let inline ap m f = f <*> m
  let inline map f m = liftM identity f m
  let inline (<!>) f m = map f m
  let inline lift2 f a b = returnM f <*> a <*> b
  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 identity m (fun _ -> f)
  let inline (>=>) f g = fun x -> f x >>= g
  let inline (<=<) x = flip (>=>) x

利用側

open System
open Library1
open Library1.Identity

type Rarity = 
  |R of string 
  |Other

// ガチャアイテム
let a,b,c,d,e,other = R("緒方智絵里"), R("間中美里"), R("黒川千秋"), R("川島瑞樹"), R("若林智香"), Other

// コンプ
let comp = [a;b;c;d;e]

// コンプ対象アイテムが出る確率
let probability = 0.12 // 12%

// 1ガチャあたり300let printg = printGacha 300 "円" (fun () -> printfn "[眠れる姫君]星井美希を手に入れた!") 

let compGacha x = 
  identity { let comp,d,probability,lst,count,total,r  = x
             let lst,count,total,r = completeGacha comp d probability lst count total 
             return (comp,d,probability,lst,count,total,r ) |> printg }

let mogemasu () = 
  (comp, other, probability, [], 0, 0, false) |> fun x -> 
  compGacha x >>= compGacha >>= compGacha >>= compGacha >>= compGacha 

// 別の書き方
//let mogemasu () = 
//  (comp, other, probability, [], 0, 0, false) |> fun x -> 
//  identity { let! x = compGacha x 
//             let! x = compGacha x 
//             let! x = compGacha x 
//             let! x = compGacha x
//             let! x = compGacha x 
//             return x }

mogemasu () |> ignore
System.Console.ReadLine () |> ignore

Console.ReadLine () |> ignore


Identityモナドを用いて実装することにより、冗長なコンピューテーション式をわざわざ作らなくても、見通しがよいコードを書くことができた。しかも、これはモナドであるためモジュール性が高い。その証拠にモナド則3の結合則から「何枚揃えるまでガチャを行うか」についての抽象を導き出すことができる。



例えばこうだ。

open System
open Library1
open Library1.Identity

type Rarity = 
  |R of string 
  |Other

// ガチャアイテム
let a,b,c,d,e,other = R("緒方智絵里"), R("間中美里"), R("黒川千秋"), R("川島瑞樹"), R("若林智香"), Other

// コンプ
let comp = [a;b;c;d;e]

// コンプ対象アイテムが出る確率
let probability = 0.12 // 12%

// 1ガチャあたり300let printg = printGacha 300 "円" (fun () -> printfn "[眠れる姫君]星井美希を手に入れた!") 

let compGacha x = 
  identity { let comp,d,probability,lst,count,total,r  = x
             let lst,count,total,r = completeGacha comp d probability lst count total 
             return (comp,d,probability,lst,count,total,r ) |> printg }

let mogemasu n = 
  (comp, other, probability, [], 0, 0, false) |> fun x -> 
  let cg = [for i in 1..n-1 do yield compGacha]
  List.fold (fun m f -> m >>= f) (compGacha x) cg

mogemasu 5 |> ignore
System.Console.ReadLine () |> ignore

Console.ReadLine () |> ignore


List.foldで必要回数分のモナドを結合することで、mogemasu関数を汎化することができた。
なお、List.foldでモナドを結合している部分は、下記のようにList.foldBackに書き直しても同様に動作する。このことからもモナド則3を満たしていることが確認できる。

let mogemasu n = 
  (comp, other, probability, [], 0, 0, false) |> fun x -> 
  let cg = [for i in 1..n-1 do yield compGacha]
  List.foldBack (fun m f -> f >>= m) cg (compGacha x)


まとめ
そのまま適用しただけでは何もしてくれないので、一見使いどころがなさそうなIdentityモナド
しかし、使えないようでいて実は割と使えるかもしれない、という話題でした。





読者の中には記事の誘導によってうまいこと騙されている人もいるかもしれないけど、
いや...、つーかさ。それ再帰で書けばいんじゃね?(核心


        i l l            ヽ    ヽ\\
        ヾy ‐-~~~ ヽ、    \    ヽ ヽ
         ィ   ヽ~\    ヽ        ヽ `、
        /         ー-、      \     `、
        /   ヽヾヽ\ ヽ\  ヽ、          、
       // /  |\      ヽ、   ヽ ヽ  |   l`、
       / |  |   l , 、\\\\       \  |   l 丶
       | l   |.   、! \ \ ー '''' ヽ、ヽ     l  |  | `
.      |.l  |  r'} 、 \,,、  、__,,、-‐''`ヽ  | |  |  |
       l.l  |  ( {  `ー''丶   '''ー- '´  |/ヽ | | | ii  |
        l   |  ヽ;      |         |' i| l | | |  i
       ヽ  .l   `i.     i       ノ, / / ///  /      __________
         \. l   ヽ.    ヽ      /`" / // |~ヽ     /
          ヽ.    ヽ  _,,,,,,_     /r、 / /  |   |  <またつまらぬコードを書いてしまった。
           \ /llヽ  ‐-、`'   /1| ヽ / /|   |    \__________
            /  ||∧.      / | |  \-‐'   |   |
        _ ,、 -/l   ||{ ヽ,,,,,,,,,/  .| |   |ヽ、、 |   |
    _,、- ' ´    |.   ||{        | |   |ヽ、 ゛|   |、,,_

関連記事


FizzBuzz問題から学ぶモナド
http://d.hatena.ne.jp/zecl/20110711/p1



上記記事で利用しているモナドもIdentityモナド

ScalazのValidationもFSharpxのValidationもApplicative



ドラゴンズドグマが楽しみだったり、しおりを温めていたScala実践プログラミングの読書を再開したりな今日この頃。
ご多聞に漏れずわたくしも五月病なので軽めのネタで。とゆーかですね、FSharpxのステマです。



FSharpxのValidationでFizzBuzz

元ネタ

ScalazのValidationでFizzBuzz
http://d.hatena.ne.jp/terazzo/20111015/1318692810


続・ScalazのValidationでFizzBuzz
http://d.hatena.ne.jp/terazzo/20111018/1318959813



そもそものきっかけはこのあたり


ScalazのValidationの謎
http://d.hatena.ne.jp/terazzo/20111022/1319295098




勉強になります。ということで、「ScalazのValidationはモナドではない」であっていました。しかしながら、Scalazの場合は「動作を変えてモナドインスタンスにすることもできる」んですね。でもそれってどうなの?エラー情報をaccumulateしないValidationって一体何。とっても意味ないんじゃー感がするんですが。できるというだけでやらないですね。



で、FSharpxというF#のOSSライブラリでも同じくValidationが実装されていまして、エラーをListMonoidとして扱ってエラー情報をaccumulateします。もちろんFSharpxのValidationもモナドではなくアプリカティブ(Applicative)として実装されています。ちょっと関連する以下のようなつぶやきも踏まえつつ、FSharpxと友達になるべくこれでFizzBuzzしてみましょう。




FSharpxの中の人的には、Choice<'T1,'T2>が生で使われちゃうこともある程度許容しているような雰囲気もなくはないですが、
生でヤっちゃうといろいろとアレということで、判別供用体のChoice1Of2とChoice2Of2を申し訳程度にラップしておく。

let success = Choice1Of2
let failure = Choice2Of2

open FSharpx.Validation

let createChoice d s = fun n -> 
  if n % d = 0 |> not then 
    success n
  else 
    failure [s]

let fizz = createChoice 3 "Fizz"
let buzz = createChoice 5 "Buzz"
let (<*) a b = lift2 (fun x _ -> x) a b
let fizzbuzz n = 
  fizz n <* buzz n
  |> function 
  | Success n -> string n
  | Failure e -> List.fold (fun a b -> b + a) "" e

[1..100] |> Seq.iter (fun x -> fizzbuzz x |> printfn "%s")

System.Console.ReadLine () |> ignore

って、ちょっと待って。FSharpxにおいてもValidationはちゃーんとApplicative考慮されていますし、当然のようにプログラムをApplicativeスタイルで書くための(<*)演算子はValidationモジュールにすでに定義済みです。上でわざわざ書いたのは、lift2していますよということを強調したかっただけでした。あとついでといっちゃーなんですが、お気に入りの「にっこり演算子」もおまけで追加しておきましょう。

let success = Choice1Of2
let failure = Choice2Of2
let (^-^) x f = x f (* にっこり *)

open FSharpx.Validation

let createChoice d s = fun n -> 
  if n % d = 0 |> not then 
    success n
  else 
    failure [s]

let fizz = createChoice 3 "Fizz"
let buzz = createChoice 5 "Buzz"
let fizzbuzz n = 
  fizz n <* buzz n
  |> function 
  | Success n -> string n
  | Failure e -> List.fold (fun a b -> b + a) "" e

[1..100] |> Seq.iter ^-^ fun x -> fizzbuzz x |> printfn "%s"

System.Console.ReadLine () |> ignore


シンプル。Validation本来の使い方とはちとズレていますが、サンプルとしてはイメージがつかみやすく結構わかり良いんじゃないでしょうか。元ネタのterazzoさんナイスですね。


参考
Scala の Either についての考察
http://d.hatena.ne.jp/xuwei/20110927/1317156625

Scalaz 6.0.4 と Haskell (GHC7.4.1) を比べてみることによってScalazのclassを分類して理解してみる
http://d.hatena.ne.jp/xuwei/20120204/1328377968


twitterで回答してくださった@xuwei_kさんの記事、参考になりました。

Retry Monad for Transient Fault Handling (Topaz + FSharpx)


4月14日に札幌で行われた第69回CLR/H勉強会にて、「Retry Monad for Transient Fault Handling - F#とWindows Azure と私 -」と題して、ライトニングトークで発表しました。


Microsoft Enterprise Library 5.0 Integration Pack for Windows Azure(EL5 for Azure)のTopaz および FSharpx を利用してモナドを作りました。Topazを利用する理由は、再利用可能な再試行戦略およびWindows Azure向けの検出戦略が組み込み済みであり、それをそのまま利用したいからです。EL5 for AzureはOSSなので、どのような実装がなされているか実際に確認することができるので、すべてをF#で書き直すこともできますが、それでは車輪の再発明になってしまいます。Retry Monad for Transient Fault Handling は、一時的障害が発生するかもしれない計算について、それぞれ異なるRetryPolicyを適用しながら再試行処理を行います。一時的な障害に対するリトライ処理をひとつの計算として包括的に扱うことができるモナド実装です。このRetryモナドの計算結果は、Choice<’T1,’T2>型で得ることができ、これによりFSharpxで定義済みの Eitherモナドで扱うこともできます。



Retry Monad for Transient Fault Handling

namespace Monad.Retry 
open System

[<AutoOpen>]
module Retry =
  // #r "Microsoft.Practices.TransientFaultHandling.Core"
  // #r "FSharpx.Core"
  open Microsoft.Practices.TransientFaultHandling
  open FSharpx
 
  [<Sealed>]
  type TransientErrorCatchAllStrategy () =
    interface ITransientErrorDetectionStrategy with
      member this.IsTransient (ex : exn)  = true

  [<Sealed>]
  type TransientErrorIgnoreStrategy () =
    interface ITransientErrorDetectionStrategy with
      member this.IsTransient (ex : exn)  = false

  let defaultRetryStrategyName = "DefaultRetry"
  let defaultRetryCount = 3
  let defaultMinBackoff = TimeSpan.FromSeconds(3.0)
  let defaultMaxBackoff = TimeSpan.FromSeconds(90.0)
  let defaultDeltaBackoff = TimeSpan.FromMilliseconds(30.0)

  let (<+) (rp:RetryPolicy<'TResultStrategy>) retrying = rp.Retrying |> Event.add(retrying)

  type RetryPolicies =
    static member NoRetry() = new RetryPolicy<TransientErrorIgnoreStrategy>(0, TimeSpan.Zero)
    static member Retry<'TTransientErrorCatchStrategy when 'TTransientErrorCatchStrategy : (new :unit -> 'TTransientErrorCatchStrategy) and 'TTransientErrorCatchStrategy :> ITransientErrorDetectionStrategy>(retryCount : int , retryInterval : TimeSpan) : RetryPolicy<'TTransientErrorCatchStrategy> =
      new RetryPolicy<'TTransientErrorCatchStrategy>(retryCount, retryInterval)
    static member Retry<'TTransientErrorCatchStrategy when 'TTransientErrorCatchStrategy : (new :unit -> 'TTransientErrorCatchStrategy) and 'TTransientErrorCatchStrategy :> ITransientErrorDetectionStrategy>(retryCount : int , initialInterval : TimeSpan, increment : TimeSpan) : RetryPolicy<'TTransientErrorCatchStrategy> =
      new RetryPolicy<'TTransientErrorCatchStrategy>(retryCount, initialInterval, increment)
    static member Retry<'TTransientErrorCatchStrategy when 'TTransientErrorCatchStrategy : (new :unit -> 'TTransientErrorCatchStrategy) and 'TTransientErrorCatchStrategy :> ITransientErrorDetectionStrategy>(retryStrategy : RetryStrategy) : RetryPolicy<'TTransientErrorCatchStrategy> =
      new RetryPolicy<'TTransientErrorCatchStrategy>(retryStrategy)
    static member RetryExponential<'TTransientErrorCatchStrategy when 'TTransientErrorCatchStrategy : (new :unit -> 'TTransientErrorCatchStrategy) and 'TTransientErrorCatchStrategy :> ITransientErrorDetectionStrategy>(retryCount : int , deltaBackoff : TimeSpan) : RetryPolicy<'TTransientErrorCatchStrategy> =
      let retryStrategy = new ExponentialBackoff(defaultRetryStrategyName, retryCount, defaultMinBackoff, defaultMaxBackoff , deltaBackoff)
      new RetryPolicy<'TTransientErrorCatchStrategy>(retryStrategy)
    static member RetryExponential<'TTransientErrorCatchStrategy when 'TTransientErrorCatchStrategy : (new :unit -> 'TTransientErrorCatchStrategy) and 'TTransientErrorCatchStrategy :> ITransientErrorDetectionStrategy>(retryCount : int , minBackoff : TimeSpan, maxBackoff : TimeSpan, deltaBackoff : TimeSpan) : RetryPolicy<'TTransientErrorCatchStrategy> =
      let retryStrategy = new ExponentialBackoff(defaultRetryStrategyName, retryCount, minBackoff, maxBackoff, deltaBackoff)
      new RetryPolicy<'TTransientErrorCatchStrategy>(retryStrategy)
    static member RetryDefault(?retryCount : int) : RetryPolicy<TransientErrorCatchAllStrategy>=
      let retryCount = defaultArg retryCount defaultRetryCount
      RetryPolicies.RetryExponential<TransientErrorCatchAllStrategy>(retryCount, defaultMinBackoff, defaultMaxBackoff, defaultDeltaBackoff)

  type Retry<'TResult> = Retry of (Lazy<unit -> 'TResult * LastException option>)
  and RetryResult<'TResult> = Choice<'TResult, LastException>
  and LastException = exn

  let exnHandler e = Retry(lazy(fun () -> Unchecked.defaultof<'TResult>, e |> Some))    
  type RetryBuilder (policy : RetryPolicy) = 
    new(?retryCount : int, ?retrying) = 
      let policy = 
        let retryCount = defaultArg retryCount defaultRetryCount
        RetryPolicies.RetryDefault(retryCount)

      retrying |> function
      | None   -> policy <+ (fun e -> printfn "%s" (sprintf "RetryPolicyName:%s, CurrentRetryCount:%d, LastException.Message:%s, Delay:%A" 
                                                            policy.RetryStrategy.Name e.CurrentRetryCount e.LastException.Message e.Delay))
      | Some retrying ->policy <+ retrying
      RetryBuilder(policy)
    
    member this.Bind (m : Retry<'TResult>, bind : ('TResult) -> Retry<'UResult>) : Retry<'UResult> = 
      Retry(lazy(fun () -> 
        m |> function
        | Retry f -> f.Force() |> fun cont -> 
          cont() ||> fun r _ -> r |> bind
        |> function
          | Retry f -> f.Force() 
          |> fun cont -> policy.ExecuteAction(Func<_>(fun () -> cont() ||> fun r _ -> r,None))))
    member this.Return (value : 'TResult) : Retry<'TResult> = 
      Retry(lazy (fun () -> policy.ExecuteAction(L.F<_>(fun () ->  value, None))))
    member this.ReturnFrom (m : Retry<'TResult>) : Retry<'TResult> = 
      m
    member this.Delay (f: unit -> Retry<unit -> 'TResult>)  : Retry<unit -> 'TResult> = 
      Retry(lazy (fun () -> policy.ExecuteAction(L.F<_>(fun () -> f() |> function | Retry f -> f.Force() |> fun cont -> cont() ||> fun f _ -> f(), None)) ||> fun r _ ->  (fun () -> r), None))
    member this.Zero () : Retry<'TResult> = 
      this.Return(Unchecked.defaultof<'TResult>)
    member this.Combine(comp1:Retry<'TResult>, comp2:Retry<'TResult>) = 
      this.Bind(comp1,(fun r -> comp2))

  let retry = new RetryBuilder()

  open Operators
  let inline returnM x = returnM retry x 
  let inline (>>=) m f = bindM retry m f
  let inline (=<<) f m = bindM retry m f
  let inline (<*>) f m = applyM retry retry f m
  let inline ap m f = f <*> m
  let inline map f m = liftM retry f m
  let inline (<!>) f m = map f m
  let inline lift2 f a b = returnM f <*> a <*> b
  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 retry m (fun _ -> f)
  let inline (>=>) f g = fun x -> f x >>= g
  let inline (<=<) x = flip (>=>) x

  let (|RetryResult|) = 
    let rec result (r:RetryResult<'TResult>) =
      match r with
      | Choice1Of2 v -> v, None
      | Choice2Of2 e -> Unchecked.defaultof<'TResult>, Some(e)
    result

  let run (retryCont : Retry<unit -> 'TResult>) : RetryResult<'TResult> =
    try
      retryCont |> function
      |(Retry f) -> f.Force()() ||> fun r e -> 
        e |> function
        |Some e -> e |> Choice2Of2
        |None   -> r() |> Choice1Of2
    with e -> e |> Choice2Of2



一時的な障害:Windows Azure(クラウド)アプリケーションを開発するにあたって対処しなければならない課題のひとつ

他のクラウドサービスに依存するようなクラウドアプリケーションを開発する場合に開発者が対処しなければならない課題の一つに、“一時的な障害” があります。インフラストラクチャレベルの障害であったり、ネットワークの問題など一時的な条件のために発生する恐れのある障害のことです。この一時的に発生しうる障害は、ほとんどの場合は短い間隔で(ほんの数ミリ秒後に)リトライ処理を行うことで回避することができます。


たとえば、Windows AzureSQL Azureプラットフォームを利用する場合。SQL Azureサービスは、共有リソース上で大規模なマルチテナントデータベースとしてサービスが提供されるので、データベースを利用するすべての利用者に対して良好なエクスペリエンスを提供しなければなりません。そのため、SQL Azureは過剰なリソースの使用や、実行時間の長いトランザクションの発行された場合など、さまざまな理由でサービスへの接続数を抑制して、利用者が意図しないタイミングで接続を切断することがあります。これが、SQL Azureを利用した場合に生じる一時的な障害ということになります。このような障害が発生した場合であってもシームレスなユーザーエクスペリエンスを提供するために、Windows Azureアプリケーション(クラウドアプリケーション)では、一時的な障害によって処理が中断された場合にはリトライを試みるようにアプリケーションを実装する必要があります。


Microsoft Enterprise Library 5.0 Integration Pack for Windows Azureを利用する

一時的な障害に対応するアプリケーションを実装する場合、Microsoft Enterprise Library 5.0 Integration Pack for Windows Azure(以降 EL5 for Azure)を利用するのが有効です。EL5 for Azureは、マイクロソフトの pattern & practice チームによる、マイクロソフト製品やテクノロジを基として、アプリケーションを構築する上でのパターンやベストプラクティスを集めたライブラリの Windows Azure向けの拡張パックです。この拡張ライブラリが提供されるまでは、一時的障害を検知してリトライ処理を行う実装を開発者自身がおのおので組み込まなければなりませんでした。EL5 for Azureには、Transient Fault Handling Application Block (Topaz)という、Windows Azureのプラットフォームに含まれるサービス利用時に発生するさまざまな一時的な障害からWindows Azureアプリケーションを回復させるためのアプリケーションブロックが提供されています。これは、Windows Azure固有の一時的な障害のみならず、オンプレミスアプリケーションで発生するさまざまな一時的な障害に対するリトライ処理についても利用可能なように設計されており、リトライ処理について高いレベルで抽象化されたアプリケーションブロックです(Microsoft.Practices.TransientFaultHandling.Core.dllにまとめらえている)。特に、Windows Azureに特化した組み込みの実装については、SQL AzureWindows Azure ストレージサービス、Windows Azure サービスバス、Windows Azure キャッシングサービス向けの検出戦略がそれぞれ提供されていて、Microsoft.Practices.EnterpriseLibrary.WindowsAzure.TransientFaultHandling.dllに含まれています。



検出戦略と再試行戦略

検出戦略は、ITransientErrorDetectionStrategyインターフェイスを実装して作成することができます。

public interface ITransientErrorDetectionStrategy
{
    bool IsTransient(Exception ex);
}

例外を引数で受け取り、その例外の種類や内部的なメッセージなどを判断して、リトライ処理を行うときは true、 リトライをせずに無視するときは falseを返すように実装するだけの非常にシンプルなインターフェイスです。Windows Azureの一時的な障害に対する4つの組み込み検出戦略として、SqlAzureTransientErrorDetectionStrategy、StorageTransientErrorDetectionStrategy、ServiceBusTransientErrorDetectionStrategy、CacheTransientErrorDetectionStrategyが提供されています。




再試行戦略は、RetryStrategy抽象クラスを継承して作成することができます。

    public abstract class RetryStrategy
    {
        public static readonly int DefaultClientRetryCount = 10;
        public static readonly TimeSpan DefaultClientBackoff = TimeSpan.FromSeconds(10.0);
        public static readonly TimeSpan DefaultMaxBackoff = TimeSpan.FromSeconds(30.0);
        public static readonly TimeSpan DefaultMinBackoff = TimeSpan.FromSeconds(1.0);
        public static readonly TimeSpan DefaultRetryInterval = TimeSpan.FromSeconds(1.0);
        public static readonly TimeSpan DefaultRetryIncrement = TimeSpan.FromSeconds(1.0);
        public static readonly bool DefaultFirstFastRetry = true;

        public static readonly RetryStrategy NoRetry = new FixedInterval(0, DefaultRetryInterval);
        public static readonly RetryStrategy DefaultFixed = new FixedInterval(DefaultClientRetryCount, DefaultRetryInterval);
        public static readonly RetryStrategy DefaultProgressive = new Incremental(DefaultClientRetryCount, DefaultRetryInterval, DefaultRetryIncrement);
        public static readonly RetryStrategy DefaultExponential = new ExponentialBackoff(DefaultClientRetryCount, DefaultMinBackoff, DefaultMaxBackoff, DefaultClientBackoff);

        protected RetryStrategy(string name, bool firstFastRetry)
        {
            this.Name = name;
            this.FastFirstRetry = firstFastRetry;
        }

        public bool FastFirstRetry { get; set; }
        public string Name { get; private set; }
        public abstract ShouldRetry GetShouldRetry();
    }


基本的な実装は、GetShouldRetryメソッドをオーバーライドし、リトライすべきタイミングか否かを表すShouldRetry デリゲートを返すように実装します。

public delegate bool ShouldRetry(int retryCount, Exception lastException, out TimeSpan delay);


ShouldRetry デリゲートは、リトライする回数と最後に発生した例外およびリトライを行うタイミングの遅延間隔を受け取り、リトライ処理を行うべきタイミングか否かを返します。組み込みで、Incremental(再試行と再試行間の増分の時間間隔数を制御する戦略)、FixedInterval(再試行と一定間隔の再試行間を制御する戦略)、ExponentialBackoff(指数関数的な遅延を計算するためのバックオフ戦略)が提供されています。



Transient Fault Handling Application Block (Topaz)によるリトライ処理の基本的な利用方法


Transient Fault Handling Application Block (Topaz)による基本的な利用方法(C#)は、検出戦略と再試行戦略を組み合わせて、RetryPolicyオブジェクトを作成し、そのRetryPolicyオブジェクトにリトライ中の処理を適宜設定し、RetryPolicyオブジェクトのExecuteActionメソッドを呼び出します。ExecuteActionメソッドへは、リトライを行いたい対象の処理を継続渡しスタイルで渡します。

var strategy = new Incremental("Incr1",10, TimeSpan.FromSeconds(1), TimeSpan.FromSeconds(1));
var policy = new RetryPolicy<SqlAzureTransientErrorDetectionStrategy>(strategy);

policy.Retrying += (_, e) =>
{
	Console.WriteLine("{0:HH:mm:ss.fff} RetryCount: {1}, ErrorMessage: {2}, StackTrace: {3}",
	    DateTime.Now,
	    e.CurrentRetryCount,
	    e.LastException.Message,
	    e.LastException.StackTrace);
};

var result = policy.ExecuteAction(() =>
{
	// SQL Azureへごにょごにょ

	return "クエリの結果などを返す";
});

EL5 for Azureはオブジェクト指向プログラミングで書かれているライブラリ、FSharpxは関数プログラミングで書かれているライブラリです。これら異なるパラダイムの部品を組み合わせてモナドを作る。とっても面白いですね。



モナドとは

モナドは単なる自己関手の圏におけるモノイド対象だよ。何か問題でも? - フィリップ・ワドラー


圏論を少しかじったことがある人にとっては問題ない説明なのですが、そうではない場合「日本語でおk」と言わざるを得ません。
この説明だけでは少々乱暴すぎるので、MSDN - コンピューテーション式(F#)へのリンクと、F#とモナドの関係について参考になりそうな表を置いておきます。


コンピュテーション式 (F#)
http://msdn.microsoft.com/ja-jp/library/dd233182(v=vs.110).aspx


Haskell F# 数学(圏論)
return return η(単位元:unit)
>>= bind (*)operator
型クラスMonadインスタンスであるように実装する コンピューテーション式で少なくとも Return と Bind の2つのmemberを実装する NA
Monad Computation Expression, Workflow モナドはKleisliトリプルと等価な定義。F# と Haskell の中で定義されるモナドの構造は実際にKleisliトリプル。
functor through a type class definition usually not mentioned 関手(functor)
function function (fun) 射(morphism)
Haskellのデータ型のHask圏 .Netデータ型の圏 グループ、位相、グラフ、微分幾何学
composable functions composable functions 2項演算とモノイド

MSDN - Code Recipe - F#によるモナドの実装方法とモナド則を確認するユニットテスト。 Retry Monad for Transient Fault Handling

モナド則を確認するためのユニットテスト等を含む、このプログラムコードのソリューションファイル一式を、MSDN - Code Recipe よりダウンロードすることができます。

http://code.msdn.microsoft.com/F-Retry-Monad-for-35ee1e72


関連記事
快刀乱麻を断つモナド - F#とIOモナドとコンピューテーション式の奥義と
http://d.hatena.ne.jp/zecl/20110703/p1