Project Euler 96

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

マスに可能な数字を次々に当てはめていき矛盾が無い解を出すだけ。それなりに速い。

import Data.Array
import qualified Data.Set as S

problems :: [[Char]] -> [[Int]] -> [[[Int]]]
problems [] p = [p]
problems (s:ss) p | head s == 'G' = p:(problems ss [])
                  | otherwise     = problems ss (p ++ [f s]) where
                    f s = [ read [c] | c <- s ]
prob ss = tail (problems ss [])

solve p = head a where
        a = update cells (array ((0, 0), (8, 8)) [ ((i, j), d) |
                    (j, xs) <- zip [0..8] p, (i, d ) <- zip [0..8] xs ])
        cells = [ (x,y) | x <- [0..8], y <- [0..8] ]
        update [] a = [a]
        update (c:cs) a | a!c /= 0    = update cs a
                        | null digits = []
                        | otherwise   = concat
                        [ update cs (a // [(c, d)]) | d <- digits ] where
                digits = possibles c a
        possibles c a = S.toList s where
                digits = map (\c -> a!c) (scan_range c)
                s = foldr (\x y -> S.delete x y) (S.fromList [1..9]) digits
        scan_range (x,y) = [ (p,q) | p <- [x0..x0+2], q <- [y0..y0+2] ]
                ++ [ (x,q) | q <- [0..8], q < y0 || y0 + 3 <= q ]
                ++ [ (p,y) | p <- [0..8], p < x0 || x0 + 3 <= p ] where
                    x0 = (div x 3) * 3
                    y0 = (div y 3) * 3

to_number a = foldl (\x y -> x * 10 + y) 0 a
head3 a = to_number [ a!(x,0) | x <- [0..2] ]

main = do
    cs <- readFile "sudoku.txt"
    print (sum (map (head3 . solve) (prob (lines cs))))