数独ソルバー作りました。
今は各数字からの影響を考えて1通りに決まるところを決定することしかできません。
(仮定のいるものなどは解けない)
とりあえず簡単な問題ならこれで解けるようになりました。
sudoku_solver.hs
import Data.Char
import Data.List
import Data.Array
import System.Environment (getArgs)
type Board = Array (Int,Int) Int
type BFilter = Array (Int,Int) [Int]
width = 9
toLine :: String -> [Int]
toLine ('_':cs) = -1 : toLine cs
toLine (x:cs) = digitToInt x : toLine cs
toLine "" = []
fromLine :: [Int] -> String
fromLine (-1:ns) = '_' : fromLine ns
fromLine (x:ns) = intToDigit x : fromLine ns
fromLine [] = ""
printBoard :: Board -> IO ()
printBoard = mapM_ putStrLn . makeBoxedList width . fromLine . elems
makeBoxedList :: Int -> [a] -> [[a]]
makeBoxedList _ [] = []
makeBoxedList n as = [b] ++ makeBoxedList n bs
where (b,bs) = splitAt n as
solve :: Board -> Board
solve b = case length numList of
0 -> b
_ -> solve $ update b numList
where numList = singleFilter . updateFilter makeFullNumMap . concat . map makeFilter . noneEmptyFilter $ b
makeFullNumMap :: BFilter
makeFullNumMap = listArray ((0, 0), (width-1, width-1)) $ cycle [[1..width]]
noneEmptyFilter :: Board -> [((Int,Int),Int)]
noneEmptyFilter = filter (\(_,z)->z/=(-1)) . assocs
makeFilter :: ((Int,Int),Int) -> [((Int,Int),Int)]
makeFilter p = acrossFilter p `union` downFilter p `union` groupFilter p `union` hereFilter p
where
acrossFilter :: ((Int,Int),Int) -> [((Int,Int),Int)]
acrossFilter ((_,y),v) = map (\x -> ((x,y),v)) [0..width-1]
downFilter :: ((Int,Int),Int) -> [((Int,Int),Int)]
downFilter ((x,_),v) = map (\y -> ((x,y),v)) [0..width-1]
groupFilter :: ((Int,Int),Int) -> [((Int,Int),Int)]
groupFilter ((x,y),v) = zip (zip [x'..x'+2] [y'..y'+2]) (cycle [v])
where (x',y') = ((x `div` 3) * 3, (y `div` 3) * 3)
hereFilter :: ((Int,Int),Int) -> [((Int,Int),Int)]
hereFilter ((x,y),_) = zip (cycle [(x,y)]) [1..width]
singleFilter :: BFilter -> [((Int,Int),Int)]
singleFilter = map (\(u,v)->(u,head v)) . filter (\(_,v)->length v==1) . assocs
updateFilter :: BFilter -> [((Int,Int),Int)] -> BFilter
updateFilter = accum (\x y -> filter (y/=) x)
update :: Board -> [((Int,Int),Int)] -> Board
update = accum (\_ a -> a)
main = do
content <- readFile =<< fmap head getArgs
let problem = listArray ((0, 0), (width-1, width-1)) $ concat $ map toLine $ lines content
putStrLn "Here is a problem:"
printBoard $ problem
putStrLn "\nThe answer is:"
printBoard $ solve problem
出力例
~$ ./sudoku_solver sudoku/free_problem1.txt
Here is a problem:
__61_7__8
8____674_
1_7832_59
_29561___
5_1__89_3
____2_16_
__5614387
78__954_6
6147_3_92
The answer is:
956147238
832956741
147832659
329561874
561478923
478329165
295614387
783295416
614783592
基本的な考え方としては、まずは[1..9]のように可能性のある数字を列挙したものを9x9マスに敷き詰め、これをBFilterとしています。
ある場所に数字があれば、その周りと同じ行と同じ列全てその数字が入ることは無いので、その数字を対応するフィルターから除去します。
フィルターに残っている数字の中で、1通りに決まるところを抜き出して、それをもとの盤に反映させます。
あとはこれを再帰的に繰り返し、1通りに決まるところがなくなれば終了です。
次は出来れば仮定を入れて(詰まったら適当に当てはめて考える)ということもやってみたいと思います。
解の一意性判定まで出来るようになるといいかなと思っています。