Life Goes On

まあまあだけど楽しんでる方です

96問目

http://projecteuler.net/index.php?section=problems&id=96
数独の問題を解く。
データ構造として、値の入った二次元リストのままだと解きにくかったので、座標と値をセットで持つタプルを使いました。
アルゴリズムとしては、取り得る値の範囲が小さいマスから埋めていく方法を採りました。もう少し複雑なアルゴリズムも試してみたのですが、問題によっては元のアルゴリズムより遅くなってしまう場合もあり、一番シンプルな方法にしました。
これはというアルゴリズムがありましたら、ぜひコメントください。(特に↓の問題)

Grid 11
000100038
200005000
000000000
050000400
400030000
000700006
001000050
000060200
060004000
import Data.Char
import Data.List
import Data.Ord

main = print . euler096 =<< readFile "sudoku.txt"

euler096 :: String -> Int
euler096 = sum . map (answer . solve) . ini . lines

ini :: [String] -> [[[Int]]]
ini [] = []
ini ss = (map (map digitToInt) $ tail x) : ini xs
    where (x , xs) = splitAt 10 ss

solve :: [[Int]] -> [[Int]]
solve = post . head . solve' . pre

pre :: [[Int]] -> [((Int, Int), Int)]
pre g = [ ((x, y), n) | x <- [0..8], y <- [0..8], let n = g !! x !! y, n /= 0 ]

solve' :: [((Int, Int), Int)] -> [[((Int, Int), Int)]]
solve' as
    | length as == 81 = [sort as]
    | otherwise = concat [ solve' as' | n <- opt, let as' = ((x, y), n) : as ]
    where ((x, y), opt) = next as

next :: [((Int, Int), Int)] -> ((Int, Int), [Int])
next as = minimumBy (comparing (length . snd)) [ ((x, y), opt) |
    x <- [0..8], y <- [0..8], notElem (x, y) (map fst as),
    let samePart ((x', y'), n) = x' == x || y' == y ||
            ((div x' 3 == div x 3) && (div y' 3 == div y 3)),
    let used = map snd $ filter samePart as,
    let opt = [1..9] \\ used ]

post :: [((Int, Int), Int)] -> [[Int]]
post [] = []
post xs = map snd x : post xs'
    where (x, xs') = splitAt 9 xs

answer :: [[Int]] -> Int
answer = read . (map intToDigit) . take 3 . head