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

F#で順列(Permutation)と組み合わせ(Combination)。YOU、Listモナドしちゃいなよ。集合モナドもあるよ。

以前、C#で順列(Permutation)と組み合わせ(Combination)をすべて列挙してみようという記事を書きました。
今見ると、前に思っていた以上に「しょっぱいなぁ」と思わざるを得ませんが、C#で書き直すつもりになれません。


今回は、超イケてる言語のF#で書きます。
そして、最近わたしがモナドにハマっているということもあり、非決定性計算を得意とするListモナドを利用したいと思います。


非決定性計算に役立つ Listモナド

Listモナドは非決定性を持つ計算について合成する戦略を持つモナドです。


ということなのですが、「非決定性計算」という言葉の意味するところを知らない場合、「お前は何を言っているんだ。」と思わざるを得ません。
一体どういうことを言っているのかというと、要は総当たりする何かの計算と思ってさしつかえないと思います。
つまり、あるリストの全要素について任意の計算を適用しながら、リストを合成して、新しいリストを作り出すための戦略がListモナドということになります。
モナドの性質をうまく利用していて、ループが複数ネストしてしまうような総当たり計算であっても、
あたかもフラットであるかのような宣言的な記述方法で、曖昧性を解決する計算を構築しやすくしてくれる。


C#VBプログラマであれば、LINQによる総当たり処理を思い浮かべてみるとイメージしやすいでしょう。
この件については、のいえさん(@neuecc)が、Linqと総当り - neue ccという記事を書いています。ぜひ参考にしてください。


Listモナドは大変便利なので、F#にもぜひ欲しい。


でもちょっと待って。そもそもF#にはシーケンス式があるよ

でも、ちょっと待ってください。
F#には、もともと シーケンス式 というナイスな構文が用意されているじゃないか。
なので「F#にListモナドなんて別にいらないんじゃね?」と思われるかもしれません。確かにそうかもしれません。
が、書き易さや可読性、メンテナンス性の観点から、私はコンピューテーション式でListモナドを用意しておきたい派です。


シーケンス式でFizzBuzzを書くとこう。

let fizzbuzz = 
  [for x in [1..100] -> 
    let f,b = "Fizz", "Buzz"
    match x % 3, x % 5 with
    | 0,0 -> f + b
    | 0,_ -> f
    | _,0 -> b
    | _   -> string x]

List.iter (fun x -> printfn "%A" x) fizzbuzz

これは、ループがひとつなので特に気になりません。


では、覆面算 SEND MORE MONEYを書いてみましょう。

let solve () =
  let digits = Set.ofList [0..9]
  let inline toInt xs  = List.fold (fun x y -> x * 10 + y) (0) xs
  [for s in digits - Set.singleton 0 do
     for e in digits - Set.singleton s do
       for n in digits - Set.ofList [s;e] do
         for d in digits - Set.ofList [s;e;n] do
           for m in digits - Set.ofList [s;e;n;d;0] do
             for o in digits - Set.ofList [s;e;n;d;m] do
               for r in digits - Set.ofList [s;e;n;d;m;o] do
                 for y in digits - Set.ofList [s;e;n;d;m;o;r] do
                   let send = toInt[s;e;n;d]
                   let more = toInt[m;o;r;e]
                   let money = toInt[m;o;n;e;y]
                   if send + more = money then
                     yield! [send; more; money]]

これはひどい。ネストが深くなってしまいました。




でも、実はインデントを下げる必要はなくて、

let solve () =
  let digits = Set.ofList [0..9]
  let inline toInt xs  = List.fold (fun x y -> x * 10 + y) (0) xs
  [for s in digits - Set.singleton 0 do
   for e in digits - Set.singleton s do
   for n in digits - Set.ofList [s;e] do
   for d in digits - Set.ofList [s;e;n] do
   for m in digits - Set.ofList [s;e;n;d;0] do
   for o in digits - Set.ofList [s;e;n;d;m] do
   for r in digits - Set.ofList [s;e;n;d;m;o] do
   for y in digits - Set.ofList [s;e;n;d;m;o;r] do
   let send = toInt[s;e;n;d]
   let more = toInt[m;o;r;e]
   let money = toInt[m;o;n;e;y]
   if send + more = money then
     yield! [send; more; money]]


と、上記のようにフラットに書くこともできます。とはいえ、決して書き易いとは言えませんし、
可読性やメンテナンス性の観点から言って欠点が多く、ある程度複雑なリストを表現するような場合は適さないと考えます。
シンプルなリストを構築する場合にシーケンス式はとても有用ですが、その他の場合ではちょっと扱いにくいでしょう。



F#で Listモナド

そこで、コンピューテーション式でListモナドを用意しておきます。


まず、Haskell での定義を。
Listモナドは型クラスMonadとMonadPlusのインスタンスとかなんとか。

instance  Monad []  where
    m >>= k  = concat (map k m)
    return x  = [x]
    fail s       = []

instance  MonadPlus []  where
    mzero =  []
    mplus = (++)


F#のコンピューテーション式で書いてみます。

type ListBuilder() =
  let concatMap f m = List.concat( List.map (fun x -> f x) m )
  member this.Bind (m, f) = concatMap (fun x -> f x) m 
  member this.Return (x) = [x]
  member this.ReturnFrom (x) = x
  member this.Zero () = []
  member this.Combine (a,b) = a@b

let list = ListBuilder()

とりあえずまぁこんなところでしょう。
より多くの機能が欲しければ、各メソッドを実装していけばよいかと。
ListモナドのBindがなぜ複数のネストしたループを表現することができるのかは、実装を見れば明らかですが、
よくわからないという場合は、「リストモナドの動作原理を考える」を参照するとよいかもしれません。



ということで、覆面算SEND MORE MONEYを、コンピューテーション式によるListモナドで。

let solve' () =
  let digits = [0..9]
  let inline toInt xs  = List.fold (fun x y -> x * 10 + y) (0) xs
  let inline (-) a b = a |> List.filter (fun x -> List.forall (fun y -> x <> y) b)
  list { let! s = digits - [0]
         let! e = digits - [s] 
         let! n = digits - [s;e]
         let! d = digits - [s;e;n]
         let! m = digits - [s;e;n;d] - [0]
         let! o = digits - [s;e;n;d;m]
         let! r = digits - [s;e;n;d;m;o]
         let! y = digits - [s;e;n;d;m;o;r]
         let send = toInt[s;e;n;d]
         let more = toInt[m;o;r;e]
         let money = toInt[m;o;n;e;y]
         if send + more = money then
           return! [send; more; money]}

とても書き易く可読性もよいですね。コンピューテーション式によるモナドなので、
モジュール性が確保されていて、シーケンス式のfor - doよりもメンテナンス性が高いです。
別途コンピューテーション式でListモナドを用意しておくことは意味のあることです。


Listモナドで順列(Permutation)と組み合わせ(Combination)

ということで、タイトルにあったように、Listモナドで順列(Permutation)と組み合わせ(Combination)を実装してみた。

F# Snippentsに投稿しました。
http://fssnip.net/6C

open System

type ListBuilder() =
  let concatMap f m = List.concat( List.map (fun x -> f x) m )
  member this.Bind (m, f) = concatMap (fun x -> f x) m 
  member this.Return (x) = [x]
  member this.ReturnFrom (x) = x
  member this.Zero () = []
  member this.Combine (a,b) = a@b
  member this.Delay f = f ()

let list = ListBuilder()

let rec permutations n lst = 
  let rec selections = function
      | []    -> []
      | x::xs -> (x,xs) :: list { let! y,ys = selections xs 
                                  return y,x::ys }
  (n, lst) |> function
  | 0, _ -> [[]]
  | _, [] -> []
  | _, x::[] -> [[x]]
  | n, xs -> list { let! y,ys = selections xs
                    let! zs = permutations (n-1) ys 
                    return y::zs }

let rec combinations n lst = 
  let rec findChoices = function 
    | []    -> [] 
    | x::xs -> (x,xs) :: list { let! y,ys = findChoices xs 
                                return y,ys } 
  list { if n = 0 then return! [[]]
         else
           let! z,r = findChoices lst
           let! zs = combinations (n-1) r 
           return z::zs }

let x4P0 = permutations 0 [1;2;3;4]
printfn "4P0 = %d" x4P0.Length
x4P0 |> Seq.iter (fun x -> printfn "%A" x)
Console.WriteLine ("-----") |> ignore

let x4P2 = permutations 2 [1;2;3;4]
printfn "4P2 = %d" x4P2.Length
x4P2 |> Seq.iter (fun x -> printfn "%A" x)
Console.WriteLine ("-----") |> ignore

let x4C0 = combinations 0 [1;2;3;4]
printfn "4C0 = %d" x4C0.Length
x4C0 |> Seq.iter (fun x -> printfn "%A" x)
Console.WriteLine ("-----") |> ignore

let x4C2 = combinations 2 [1;2;3;4]
printfn "4C2 = %d" x4C2.Length
x4C2 |> Seq.iter (fun x -> printfn "%A" x)
Console.ReadLine () |> ignore


コード短すぎワロスwww さすが俺たちのF#さん!!



笑わない数学者「5つのビリヤード玉問題」

笑わない数学者からの挑戦状
http://r27.jp/quiz/mathematical-goodbye/



さっそく利用してみる。笑わない数学者「5つのビリヤード玉問題」を解いてみましょう。

// 5つのビリヤード玉問題
let billiardsProblem = 
  let judge (xs:int list) = 
    let a,b,c,d,e = (xs.[0],xs.[1],xs.[2],xs.[3],xs.[4])
    [a;b;c;d;e]@
    [a+b;b+c;c+d;d+e;e+a]@
    [a+b+c;b+c+d;c+d+e;d+e+a;e+a+b]@
    [a+b+c+d;b+c+d+e;c+d+e+a;d+e+a+b;e+a+b+c]@
    [a+b+c+d+e] 
    |> List.sort 
  list { let! xs = permutations 5 [1..11] 
         if [1..21] = judge xs then          
           return xs}

billiardsProblem |> printfn "%A" 


実行結果

[[1; 3; 10; 2; 5]; [1; 5; 2; 10; 3]; [2; 5; 1; 3; 10]; [2; 10; 3; 1; 5];
 [3; 1; 5; 2; 10]; [3; 10; 2; 5; 1]; [5; 1; 3; 10; 2]; [5; 2; 10; 3; 1];
 [10; 2; 5; 1; 3]; [10; 3; 1; 5; 2]]

おまけ:集合モナド


Collections.Set<'T> クラス (F#)
http://msdn.microsoft.com/ja-jp/library/ee353619.aspx


Collections.Set Module (F#)
http://msdn.microsoft.com/ja-jp/library/ee340244.aspx


はい。あいかわらず機械翻訳が残念なことになっていますが、
上記のとおりF#では集合を扱うクラスとモジュールが用意されています。
Listだけじゃなく、集合もモナドになってたらいんじゃね?という単純すぎる発想です。
とはいえ、基本的にListで代用できてしまうので、ありがたみは少ししかないかもしれませんが…。


集合モナド

type SetBuilder() =
  let unionManyMap f m = Set.unionMany ( Set.map (fun x -> f x) m )
  member this.Bind (m, f) = unionManyMap (fun x -> f x) m 
  member this.Return (x) = Set.ofList x
  member this.ReturnFrom (x) = x
  member this.Zero () = Set.empty
  member this.Combine (a,b) = Set.union a b

let set = SetBuilder ()


Listモナドを集合用に単純に書き換えただけですね。
Listモナドで言うところのconcatMapがunionManyMapとなっています。
積集合や対称差のための関数や演算子を用意するなどして、モジュールを充実させるとより扱いやすくなるかも。


集合モナドと他の方法とで、非決定性計算の速度を比較してみる。

let getProcessingTime f = 
  let s = new System.Diagnostics.Stopwatch ()
  s.Start()
  let r = f ()  
  s.Stop ()
  r,s.Elapsed 

Console.WriteLine ("----- send + more = money -- for Set")
let solve () =
  let digits = Set.ofList [0..9]
  let inline toInt xs  = List.fold (fun x y -> x * 10 + y) (0) xs
  [for s in digits - Set.singleton 0 do
   for e in digits - Set.singleton s do
   for n in digits - Set.ofList [s;e] do
   for d in digits - Set.ofList [s;e;n] do
   for m in digits - Set.ofList [s;e;n;d;0] do
   for o in digits - Set.ofList [s;e;n;d;m] do
   for r in digits - Set.ofList [s;e;n;d;m;o] do
   for y in digits - Set.ofList [s;e;n;d;m;o;r] do
   let send = toInt[s;e;n;d]
   let more = toInt[m;o;r;e]
   let money = toInt[m;o;n;e;y]
   if send + more = money then
     yield! [send; more; money]]
printfn "%A" <| getProcessingTime solve

Console.WriteLine ("----- send + more = money -- Listモナド")
let solve' () =
  let digits = [0..9]
  let inline toInt xs  = List.fold (fun x y -> x * 10 + y) (0) xs
  let inline (-) a b = a |> List.filter (fun x -> List.forall (fun y -> x <> y) b)
  list { let! s = digits - [0]
         let! e = digits - [s] 
         let! n = digits - [s;e]
         let! d = digits - [s;e;n]
         let! m = digits - [s;e;n;d] - [0]
         let! o = digits - [s;e;n;d;m]
         let! r = digits - [s;e;n;d;m;o]
         let! y = digits - [s;e;n;d;m;o;r]
         let send = toInt[s;e;n;d]
         let more = toInt[m;o;r;e]
         let money = toInt[m;o;n;e;y]
         if send + more = money then
           return! [send; more; money]}

printfn "%A" <| getProcessingTime solve'

Console.WriteLine ("----- send + more = money -- Setモナド")
let solve'' () =
  let digits = Set.ofList [0..9]
  let inline toInt xs  = List.fold (fun x y -> x * 10 + y) (0) xs
  set { let! s = digits - Set.singleton 0
        let! e = digits - Set.singleton s
        let! n = digits - Set.ofList [s;e]
        let! d = digits - Set.ofList [s;e;n;]
        let! m = digits - Set.ofList [s;e;n;d;0]
        let! o = digits - Set.ofList [s;e;n;d;m]
        let! r = digits - Set.ofList [s;e;n;d;m;o]
        let! y = digits - Set.ofList [s;e;n;d;m;o;r]
        let send = toInt[s;e;n;d]
        let more = toInt[m;o;r;e]
        let money = toInt[m;o;n;e;y]
        if send + more = money then
          return [send; more; money]}

printfn "%A" <| getProcessingTime solve''

Console.WriteLine ("----- send + more = money -- Seq")
let solve''' () =
  let digits = Set.ofList [0..9]
  let inline toInt xs  = List.fold (fun x y -> x * 10 + y) (0) xs
  seq {for s in digits - Set.singleton 0 do
       for e in digits - Set.singleton s do
       for n in digits - Set.ofList [s;e] do
       for d in digits - Set.ofList [s;e;n] do
       for m in digits - Set.ofList [s;e;n;d;0] do
       for o in digits - Set.ofList [s;e;n;d;m] do
       for r in digits - Set.ofList [s;e;n;d;m;o] do
       for y in digits - Set.ofList [s;e;n;d;m;o;r] do
       let send = toInt[s;e;n;d]
       let more = toInt[m;o;r;e]
       let money = toInt[m;o;n;e;y]
       if send + more = money then
         yield! [send; more; money] }
printfn "%A" <| getProcessingTime solve'''

Console.ReadLine () |> ignore


実行結果(マシンスペック等はお察しください)

----- send + more = money -- for Set
([9567; 1085; 10652], 00:00:04.2887953)
----- send + more = money -- Listモナド
([9567; 1085; 10652], 00:00:02.1857583)
----- send + more = money -- Setモナド
(set [1085; 9567; 10652], 00:00:05.1224592)
----- send + more = money -- Seq
(seq [9567; 1085; 10652], 00:00:00.0014052)


「集合モナド遅せーじゃん。」って、なってしまうわけですが、それは問題の性質や領域によって変わってくるお話。
この覆面算については扱う集合があまりにも単純すぎて、リストで扱った方が高速になるが、
より複雑な集合問題を扱う場合は、集合モナドを利用した方がよりシンプルに書くことができて、高速に処理できます。たぶん。
まぁ、多くの場合はListモナドで事足りてしまうような気がするので、集合モナドの活躍の場はあんまりないかも(えっ。
そして一見、「seq が圧倒的パフォーマンスを見せつけているぞ!」と思うかもしれませんが、それはぜんぜん違うくて、
単に遅延評価が働いているだけです。今回の時間の計測方法では早いように見えるだけです。seq は IEnumerable ですからね。お間違えのないように。



ということで、Listモナドで順列(Permutation)と組み合わせ(Combination)を実装しなおしてみたら、
C#と比較にならないくらい短く書けましたよ!というご報告でした。俺達のF#がふつくしすぎる。