Skip to content

Instantly share code, notes, and snippets.

# tiqwab/Sudoku.hs Last active Aug 6, 2016

 import Data.List import Control.Monad.Reader import Control.Monad.Writer import Data.Maybe -- Pair of row and column type Position = (Int, Int) -- Pair of Position and possible numbers type Cell = (Position, [Int]) -- List of Cell type Board = [Cell] numbers = [1, 2, 3, 4, 5, 6, 7, 8, 9] {- Parse input into Board. Input has format like 'positionX postitionY Number'. Eg. 1 1 1 2 5 1 3 ... -} parseBoard :: [String] -> Board parseBoard xs = map doParseBoard xs where doParseBoard input = let inputs = map read . words \$ input x = inputs !! 0 y = inputs !! 1 remain = snd \$ splitAt 2 inputs in ((x,y), remain) rowAt :: Position -> Board -> [Cell] rowAt (x, y) board = filter (\((px, py), _) -> px == x) board colAt :: Position -> Board -> [Cell] colAt (x, y) board = filter (\((px, py), _) -> py == y) board boxAt :: Position -> Board -> [Cell] boxAt (x, y) board = filter (\((px, py), _) -> px `elem` bx && py `elem` by) board where bx = rangeThree x by = rangeThree y rangeThree n | n < 4 = [1, 2, 3] | n < 7 = [4, 5, 6] | n < 10 = [7, 8, 9] | otherwise = error "Invalid number" getNumber :: Cell -> Maybe Int getNumber (_, [x]) = Just x getNumber (_, _) = Nothing setNumber :: [Int] -> Position -> Board -> Board setNumber nums position board = let (former, _:latter) = break (\(p, _) -> p == position) board in former ++ ((position, nums):latter) getNumberFromPosition :: Position -> Board -> Maybe [Int] getNumberFromPosition position board = (find (\(p, _) -> p == position) board) >>= (\x -> return \$ snd x) solved :: Board -> Bool solved board = length (filter (\(p, xs) -> length xs /= 1) board) == 0 {- Solution 1 -} appearRow :: Position -> Board -> [Int] appearRow position board = catMaybes \$ map getNumber \$ rowAt position board appearCol :: Position -> Board -> [Int] appearCol position board = catMaybes \$ map getNumber \$ colAt position board appearBox :: Position -> Board -> [Int] appearBox position board = catMaybes \$ map getNumber \$ boxAt position board -- Collect possible numbers in the position candidate :: Position -> Board -> [Int] candidate position board = numbers \\ appears where appears = runReader r board r = do n1 <- reader \$ appearRow position n2 <- reader \$ appearCol position n3 <- reader \$ appearBox position return (n1 `union` n2 `union` n3) scanCandidate :: Board -> Board scanCandidate board = map doScan board where doScan (p, [x]) = (p, [x]) doScan (p, _) = (p, candidate p board) -- Solve Sudoku by `scanCandidate` solveSudoku1 :: Board -> Board solveSudoku1 board | solved board = board | otherwise = solveSudoku1 (scanCandidate board) {- Solution 2 -} onlyInRow :: Position -> Board -> Maybe [Int] onlyInRow position board = do target <- getNumberFromPosition position board let others = foldl union [] (map snd \$ filter ((/=) position . fst) \$ rowAt position board) onlyIn target others onlyInCol :: Position -> Board -> Maybe [Int] onlyInCol position board = do target <- getNumberFromPosition position board let others = foldl union [] (map snd \$ filter ((/=) position . fst) \$ colAt position board) onlyIn target others onlyInBox :: Position -> Board -> Maybe [Int] onlyInBox position board = do target <- getNumberFromPosition position board let others = foldl union [] (map snd \$ filter ((/=) position . fst) \$ boxAt position board) onlyIn target others onlyIn :: [Int] -> [Int] -> Maybe [Int] onlyIn target others = case target \\ others of [x] -> Just [x] _ -> Nothing -- Find a number which is only one possible in the position. only :: Position -> Board -> [Int] only position board = case result of Just xs -> xs Nothing -> fromJust original where original = getNumberFromPosition position board r = do n1 <- reader \$ onlyInRow position n2 <- reader \$ onlyInCol position n3 <- reader \$ onlyInBox position return (n1 `mplus` n2 `mplus` n3 `mplus` original) result = runReader r board scanOnly :: Board -> Board scanOnly board = map doScan board where doScan (p, [x]) = (p, [x]) doScan (p, xs) = (p, only p board) -- Solve Sudoku by `scanCandidate` and `scanOnly` solveSudoku2 :: Board -> Board solveSudoku2 board | solved board = board | otherwise = solveSudoku2 (scanOnly . scanCandidate \$ board)
Owner Author

### tiqwab commented Aug 6, 2016 • edited

 これではいわゆる「仮置き」が必要になる問題は解けないよう。 数字の候補の中から適当に選んで埋めていく深さ優先探索が必要になる。
to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.