Project Euler 84

http://projecteuler.net/index.php?section=problems&id=84

基本的にProblem 280と同じだが、圧倒的に複雑。遷移確率を求めて、100回目の分布を計算する。しかし、どこかが間違っているらしい。結果的には正しい答えが出てくるが。
以前はどうやったのかコードを見てみたら、100万回シミュレートしていた。

import qualified Data.Map as M
import Data.List

nface = 4
const_p = 1 / 16

collect a = M.toList (f a M.empty) where
        f [] m = m
        f ((n,p):xs) m = f xs (M.insert n q m) where
                q = if M.member n m then (m M.! n) + p else p

dices m n k
        | m == n && k == 3 = [(-1, const_p)]
        | m == n = [ (if l > 0 then n + n + l else -1, p * const_p) |
            i <- [1..nface], j <- [1..nface], (l, p) <- dices i j (k+1) ]
        | otherwise = [(m + n, const_p)]
dice = collect (concat [ dices m n 1 | m <- [1..nface], n <- [1..nface] ])

next :: Int -> [(Int, Double)]
next n = collect (concat [ g n e | e <- dice ]) where
        g n (-1,p) = [ (10, p) ]
        g n ( m,p) = [ (l, p * q) | (l, q) <- f (mod (n + m) 40) ]
        f n =    if n == 30 then
                [(10, 1.0)]
            else if n == 2 || n == 17 || n == 33 then
                [(0, 1 / 16),(10, 1 / 16),(n, 14 / 16)]
            else if n == 7 || n == 22 || n == 36 then
                [(0, 1 / 16),(10, 1 / 16),(11, 1 / 16),(24, 1 / 16),
                (39, 1 / 16),(5, 1 / 16),(n, 6 / 16),
                (nextr n, 2 / 16),(nextu n, 1 / 16)] ++ (back3 n)
            else [(n, 1.0)]
        
        nextr n = mod ((div (n + 5) 10) * 10 + 5) 40
        nextu n = if 12 <= n && 28 < n then 28 else 12
        back3 n = [ (m, p / 16) | (m, p) <- f (n - 3) ]

step ps = collect [ (m, p * q) | (n, p) <- ps, (m, q) <- next n ]

a = [(0, 1.0)]:[ step e | e <- a ]
b = sortBy (\x y -> compare (snd y) (snd x)) (a!!100)
main = print (take 3 (map fst b))