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