This is an incredibly crude Haskell-newbie attempt at solving Sudoku, largely
because I know how to play Sudoku. That means I'm not going to use anything
useful like Monads, nor any intelligence in the algorithm. It's basically just
going to try every possible combination and print out every one that works.
Main! In order to create an executable with GHC, the 'main' function needs to
be in the 'Main' module.
> module Main where
We need to import the IO system. This is roughly equivalent to including
stdio.h in C.
> import IO
Also, in order to read the command line arguments, we need System.Environment.
> import System.Environment
We define a board as a list of lists of 'Int's. As a rule, the board is 9x9,
and contains numbers 1 through 9 (1..9). It can also contain the number 0 to
indicate that it's a free position (still needs to be guessed).
> type Board = [[Int]]
So we'll create a few helper functions to create a 'Board' from a 'String' and
vice versa.
> strToBoard :: String -> Board
> strToBoard = map (map read) . map words . lines
>
> boardToStr :: Board -> String
> boardToStr = unlines . map unwords . map (map show)
This simply tests if you can place the digit in the board at the specified row
and column, given the current numbers that have already been placed in the
board.
The only three rules of Sudoku are that a number cannot be repeated in a row, a
column, or the 3x3 box that it's part of.
> canPlace :: Int -> Board -> Int -> Int -> Bool
> canPlace digit board row col
> | row < 0 || row > 8 = False
> | col < 0 || col > 8 = False
> | digit < 1 || digit > 9 = False
> | ((board !! row) !! col) /= 0 = False
> | alreadyInRow digit board row = False
> | alreadyInCol digit board col = False
> | alreadyInBox digit board row col = False
> | otherwise = True
This is an easy check. We just pull one row out of the board, and see if any
number in that row is equal to the digit that we're checking.
> alreadyInRow :: Int -> Board -> Int -> Bool
> alreadyInRow digit board row = digit `elem` (board !! row)
This is slightly more complicated. We're pulling all the numbers in one row out
of the board. Once we have all the numbers from the column, we check if any of
them are equal to the digit we're looking for.
> alreadyInCol :: Int -> Board -> Int -> Bool
> alreadyInCol digit board col = digit `elem` (map (!! col) board)
This is really easy because we have a spiffy helper function to hide the ugly
details!
> alreadyInBox :: Int -> Board -> Int -> Int -> Bool
> alreadyInBox digit board row col = digit `elem` (boxAt board row col)
The ugly details! We find the top left corner and put all the elements in the
box into one list.
> boxAt :: Board -> Int -> Int -> [Int]
> boxAt board row col =
> (take 3 . drop top) (board !! (left + 0)) ++
> (take 3 . drop top) (board !! (left + 1)) ++
> (take 3 . drop top) (board !! (left + 2))
> where top = (col - (col `mod` 3))
> left = (row - (row `mod` 3))
This is a pretty naive check. It doesn't verify that the answers are correct;
it simply verifies that all of the entries have been filled in.
> solved :: Board -> Bool
> solved = notElem 0 . foldl (++) []
This simply finds the next place in the board that has an open spot. There's
probably a faster way of doing this.
> next0 :: Board -> (Int, Int)
> next0 board = (row, col)
> where row = length $ takeWhile (\ x -> length x == 9) (map (takeWhile (/= 0)) board)
> col = length $ takeWhile (/= 0) (board !! row)
The next two functions replace a certain position in the board with our guess.
There's probably also a faster way of doing this but I have no idea how. I
think I probably actually saw this code in a tutorial somewhere.
> replace :: Int -> [Int] -> Int -> [Int]
> replace _ [] _ = []
> replace digit (y:ys) col
> | col > 0 = y : replace digit ys (col - 1)
> | otherwise = digit : ys
>
> putAt :: Int -> Board -> Int -> Int -> Board
> putAt _ [] _ _ = []
> putAt digit board row col
> | row > 0 = (head board) : putAt digit (tail board) (row - 1) col
> | otherwise = replace digit (head board) col : (tail board)
This is the intelligence of our program! We're taking in a board and returning
all of the possible solutions given the configuration.
If the board is already solved, there's nothing for us to check!
If the next spot that has a 0 (the next place we need to check) doesn't have
any numbers that can be placed there, then this board has no valid solution,
and we can just return the empty list here.
Otherwise, we replace the next 0 in the board with each of our options for that
spot, and try to solve each board given those options. 'map solveBoard' takes
[Board] and returns [[Board]], so we fold all the inner lists together to just
get [Board], which is what we want.
> solveBoard :: Board -> [Board]
> solveBoard board
> | solved board = [board]
> | options == [] = []
> | otherwise = foldl (++) [] $ map solveBoard $ map (\ x -> putAt x board row col) options
> where options = filter (\ x -> canPlace x board row col) [1..9]
> (row, col) = next0 board
And note that everything so far has been completely Monad-free. Now we'll just
write a quick main function that pulls in a board from a file specified as the
first argument, or stdin if it's unspecified (beware, /dev/stdin only works on
posix, and this is quick and dirty).
Then we convert the 'String' contents to a 'Board', get all the solutions to
the board, convert all the solutions to 'String's, and then join all the
'String's together and print them all out.
> main :: IO ()
> main = do
> args <- getArgs
> board <- readFile $ if (length args == 0) then "/dev/stdin" else (head args)
> putStr $ (unlines . map boardToStr . solveBoard . strToBoard) board