数独
正月にお義父さんから勧められて数独をやりました。初めてやりましたが、なかなか面白いですね。
Haskellで作ってみました。
-- Sudoku.hs import Data.List ((\\)) import System.Environment (getArgs) data Cell = Cell {row::Int,col::Int,val::String} deriving Show readCSV :: String -> [[String]] readCSV contents = map (splitCSV) $ lines contents where splitCSV "" = [] splitCSV l = let (x, y) = break (== ',') l in x:splitCSV (tail' y) tail' "" = "" tail' xs = tail xs makeCells :: [[String]] -> [Cell] makeCells xs = makeCells' 0 xs where makeCells' _ [] = [] makeCells' n (y:ys) = makeCell n 0 y ++ makeCells' (n + 1) ys makeCell :: Int -> Int -> [String] -> [Cell] makeCell _ 9 _ = [] makeCell r c [] = [Cell r c ""] makeCell r c (x:xs) = (Cell r c x):makeCell r (c + 1) xs h_collect :: Int -> [Cell] -> [Cell] h_collect r xs = filter (\(Cell x _ _) -> r == x) xs v_collect :: Int -> [Cell] -> [Cell] v_collect c xs = filter (\(Cell _ x _) -> c == x) xs b_collect :: Int -> Int -> [Cell] -> [Cell] b_collect r c cells = collect cells where x = if r < 3 then 0 else if r < 6 then 3 else 6 y = if c < 3 then 0 else if c < 6 then 3 else 6 collect = filter (\(Cell r c _) -> ((x <= r) && (x + 3 > r)) && ((y <= c) && (y + 3 > c))) eval :: [Cell] -> [Cell] -> [Cell] eval [] ys = if check ys then ys else eval ys [] eval xss@((Cell r c vv):xs) ys = if null vv then let x = Cell r c searched in eval xs (ys ++ [x]) else eval xs (ys ++ [Cell r c vv]) where zs = ys ++ xss h = map (read' . val) (h_collect r zs) v = map (read' . val) (v_collect c zs) b = map (read' . val) (b_collect r c zs) a = (([1,2..9] \\ h) \\ v) \\ b searched = if length a == 1 then show (head a) else "" read' "" = 0 read' x = read x check :: [Cell] -> Bool check = all (not . null) . map val toStr :: Cell -> String toStr (Cell r c v) = if c == 8 then v ++ "\n" else v ++ "," main = do (f:_) <- getArgs exec f exec f = do cells <- return . makeCells . readCSV =<< readFile f str <- return $ concatMap toStr $ eval cells [] writeFile "answer.txt" str
引数にCSV形式の問題ファイルを与えます。
> runhaskell Sudoku.hs problem.txt
problem.txtはこんな感じ。
,,,,6,,,8,9 ,8,1,,,,,4,5 ,,4,8,,,3,7, ,,,4,5,,9,, 3,,,,,,,,1 ,,5,,7,1,,, ,4,8,,,2,5,, 7,5,,,,,2,3, 9,2,,,8,,,,
answer.txtに答えが出力されます。
5,3,7,2,6,4,1,8,9 2,8,1,3,9,7,6,4,5 6,9,4,8,1,5,3,7,2 8,1,2,4,5,3,9,6,7 3,7,9,6,2,8,4,5,1 4,6,5,9,7,1,8,2,3 1,4,8,7,3,2,5,9,6 7,5,6,1,4,9,2,3,8 9,2,3,5,8,6,7,1,4