Haskellコードゴルフ：サイコロ問題
リスト内包表記を使えば、「サイコロを３回振った時の組み合わせ」のような、組み合わせのリストを作ることができます。
Prelude> [[x,y,z]|x<-[1..6],y<-[1..6],z<-[1..6]] [[1,1,1],[1,1,2],[1,1,3],[1,1,4],[1,1,5], 〜略〜 ,[6,6,5],[6,6,6]]
数の組み合わせについて考えるときに重宝してはいるのですが、単に数の組み合わせを出すだけならもっと簡単にできないかと思うわけです。
つまり、m面のサイコロをn回振った組み合わせ・・・のような数を返す、次のような関数fがあると良いですね。
Prelude> f 6 3 [[1,1,1],[1,1,2],[1,1,3],[1,1,4],[1,1,5], 〜略〜 ,[6,6,5],[6,6,6]]
６面のサイコロだけじゃなくて、各面に番号が振られた正四面体とか、複数のコインの裏表の組み合わせとか、そういう風に考えてもらっても良いです。
標準でこういう事ができる関数ってありましたっけ？
無いですよね？
無いことにして進めます。別に速度は早くなくても良いのですが、めちゃくちゃ良く使うので、モジュール化するだけでなく、ghciにベッっとはってパパッっと実行できるくらいのサイズに収めたいです。
折角なのでコードゴルフに挑戦してみましょう、どのくらいまで短くできるか挑戦してみます。
問題：
m面のサイコロをn回振ったとき、出た目の組み合わせを全て返す関数fを定義せよ。
ただしghciの環境において一行で書くことができ、使うことができる関数はPreludeで定義されているもののみとする。
普通の６面のサイコロで考えると組み合わせが多くなりすぎて、目で追うのが大変なので、３面３回で考えましょう。正三面体は存在しえないですし、別にサイコロに拘らなくても良いです、ようは単なる組み合わせの数なので。
まず普通にリスト内包表記で。
Prelude> [[x,y,z]|x<-[1..3],y<-[1..3],z<-[1..3]] [[1,1,1],[1,1,2],[1,1,3],[1,2,1] 〜略〜 [3,3,1],[3,3,2],[3,3,3]]
このままだと柔軟性に乏しいので、リストモナドにしたほうが良いですね。
リストモナドの >>= はconcatMapなのでそれを利用して・・・
Prelude> [1..3] >>= \x -> [1..3] >>= \y -> [1..3] >>= \z -> [[x,y,z]] [[1,1,1],[1,1,2],[1,1,3],[1,2,1] 〜略〜 [3,3,1],[3,3,2],[3,3,3]]
ここで、x、y、zそれぞれの変数にリストを割り当ててるので、サイコロを振る回数は一定になってしまい、このままでは使えませんが、>>= が連なっているのを利用して、なんとか同じ形の繰り返しにできないでしょうか。
二回だけ振った場合を考えて・・・
Prelude> [1..3] >>= \x -> [1..3] >>= \y -> [[x,y]] [[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]
その後ろにもう一回分付け加えます。
Prelude> [1..3] >>= \x -> [1..3] >>= \y -> [[x,y]] >>= \t -> [1..3] >>= \z -> [[z:t]] [[[1,1,1]],[[2,1,1]],[[3,1,1]],[[1,1,2]], 〜略〜 ,[[1,3,3]],[[2,3,3]],[[3,3,3]]]
このままだと余計な二重リストができてしまっているので、concatで外します。
Prelude> [1..3] >>= \x -> [1..3] >>= \y -> [[x,y]] >>= \t -> [1..3] >>= \z -> [concat[z:t]] [[1,1,1],[2,1,1],[3,1,1], 〜略〜 ,[1,3,3],[2,3,3],[3,3,3]]
よしよし、良い感じになってきました。
追加した後ろの式を取り出して型を見てみましょう。
Prelude> :t (>>= \t -> [1..3] >>= \z -> [concat[z:t]]) (>>= \t -> [1..3] >>= \z -> [concat[z:t]]) :: (Num t, Enum t) => [[t]] -> [[t]]
見たまんま、a -> a の型になっているので、これを繋げていくことでサイコロを振る回数を増やしていくことができそうです。
この部分を一旦 f' という関数に置き換えてやりましょう。ラムダ式の仮引数の名前は変更しておきます。
Prelude> let f' = (>>= \x -> [1..3] >>= \y -> [concat[y:x]]) Prelude> :t f' f' :: [[Integer]] -> [[Integer]]
型が少し変わっていますが、どうせ扱うのは整数なので問題無いです。
では実際に繋げて実行してみましょう。
Prelude> -- [[]] :: [[a]] なのを利用する Prelude> f'.f'.f' $ [[]] [[1,1,1],[2,1,1],[3,1,1],[1,2,1], 〜略〜 ,[3,2,3],[1,3,3],[2,3,3],[3,3,3]]
良い感じです、実際にはこのf'は、3回限定ではなくm回繰り返したいので、[f',f',f',..,f']のような関数のリストを(.)でたたみ込む方法を考えてみました。
Prelude> let f = (foldr (.) id $ replicate 3 f')[[]] Prelude> f [[1,1,1],[2,1,1],[3,1,1],[1,2,1], 〜略〜 ,[3,2,3],[1,3,3],[2,3,3],[3,3,3]]
f'を展開します。
Prelude> let f = (foldr (.) id $ replicate 3 (>>= \x -> [1..3] >>= \y -> [concat[y:x]]))[[]] Prelude> f [[1,1,1],[2,1,1],[3,1,1],[1,2,1], 〜略〜 ,[3,2,3],[1,3,3],[2,3,3],[3,3,3]]
後は定数を各々置き換えて、目的の関数は完成しました。
Prelude> let f m n = (foldr (.) id $ replicate n (>>= \x -> [1..m] >>= \y -> [concat[y:x]]))[[]] Prelude> f 2 4 [[1,1,1,1],[2,1,1,1],[1,2,1,1], 〜略〜 ,[2,1,2,2],[1,2,2,2],[2,2,2,2]] Prelude> f 3 2 [[1,1],[2,1],[3,1],[1,2],[2,2],[3,2],[1,3],[2,3],[3,3]]
後になって気づいたのですが、そもそも同じ関数を繰り返すのにfoldrなんぞは使わずに、 iterate f x = [f x,f (f x), f (f (f x)),..] な事を利用すれば大分短くなります。
Prelude> let f m n = (iterate (>>= \x -> [1..m] >>= \y -> [concat[y:x]]) [[]])!!n Prelude> f 5 2 [[1,1],[2,1],[3,1],[4,1],[5,1], 〜略〜 ,[3,5],[4,5],[5,5]]
この後、リストモナドをリスト内包表記に変えられればもっと短くできるかと思うのですが、どうにも上手くいかなかったので今回は諦めます。
後は、見やすくするためのスペースをぎゅっと詰めて、解答例とします。
Prelude> let f m n=(iterate(>>= \x->[1..m]>>= \y->[concat[y:x]])[[]])!!n
うん、大分短くなりました。自分はこれが限界です。
最後に一つ、活用例を示して終りにします、８面のサイコロを３つ降って、和が１２になるものだけ列挙するなら、次のようにすればOKです。
Prelude> let f m n=(iterate(>>= \x->[1..m]>>= \y->[concat[y:x]])[[]])!!n Prelude> filter (\l -> sum l == 12) $ f 8 3 [[8,3,1],[7,4,1],[6,5,1],[5,6,1], 〜略〜 ,[2,3,7],[1,4,7],[3,1,8],[2,2,8],[1,3,8]]
だいぶ頭の体操になりましたね、もしもっと短くかけた方が居たら教えてください。ではでは、おやすみなさい。
2012/3/29 追記
f m n = sequence $ replicate n [1..m]
uskzさんに教えて頂きました。ありがとうございますm(__)m
もう、今まで悩んでたのが何だったのかってくらい綺麗に纏まってしまいました。
sequence関数の動作については以下を見ればなんとなく解るかと思います。
Prelude> :t sequence sequence :: (Monad m) => [m a] -> m [a] Prelude> sequence [Just 3, Just 4, Just 5] Just [3,4,5] Prelude> sequence [Just 3, Nothing, Just 5] Nothing
ちなみに、sequenceの再実装ができないか四苦八苦していたらTwitterで。
sequence = foldr (liftM2 (:)) (return [])
