This solves Sudoku by using backtracking. Accepts one grid where 0 represents a missing number. Here are some examples: http://norvig.com/easy50.txt
The program is quite slow. Input is stdin.
import Data.Char (isDigit)
import Data.List (intersperse, delete)
printGrid [] = []
printGrid x = (intersperse ' ' $ take 9 x) ++ "\n" ++ (printGrid $ drop 9 x)
solve x = if isSolved x then x
else
firstSolved cands
where
firstSolved [] = []
firstSolved (c:cs) = if isSolved trial then trial else firstSolved cs
where
trial = solve c
cands = candidates x
isSolved x = (length x == 81) && (not $ elem '0' x) && (isValidCandidate x)
candidates x = filter isValidCandidate [(takeWhile (/='0') x) ++ z ++ (tail $ dropWhile (/='0') x) | z <- map show [1..9]]
isValidCandidate x = not $ any (isInvalidCand x) [0..80]
isInvalidCand x i = (x !! i /= '0') &&
any (elem ic) [row, col, unit]
where
ix = mod i 9
iy = quot i 9
ic = x !! i
row = [x !! a | a <- [9*iy..(9*iy + 8)], a /= i]
col = [x !! a | a <- [ix, (ix + 9)..(ix + 72)], a /= i]
icx = (quot ix 3) * 3
icy = (quot iy 3) * 3
si = (9*icy) + icx
unit = map (x !!) (delete i [si, si + 1, si + 2, si + 9, si + 10, si + 11, si + 18, si + 19, si + 20])
main :: IO ()
main = interact $ printGrid . solve . filter isDigit
-
\$\begingroup\$ Have you seen this Sudoku in Haskell functional pearl by Graham Hutton? It's a thing of beauty. \$\endgroup\$bisserlis– bisserlis2015年04月26日 06:12:03 +00:00Commented Apr 26, 2015 at 6:12
-
\$\begingroup\$ It is nice, but I already saw the idea in Norvig's article on constraint propagation. I was hoping to get an improvement in my code style. \$\endgroup\$ssh– ssh2015年04月26日 13:14:08 +00:00Commented Apr 26, 2015 at 13:14
1 Answer 1
Since you said you were looking for suggestions for coding style I will focus on that.
Comment your code! Preferably with Haddock style comments. Even if you aren't planning on sharing your code with others, having comments will still help you if you decide to come back to a project after a break.
Haddock is a system that will automatically generate documentation based on your comments. Formatting your comments to work with Haddock basically just mean adding a | as the first character of your top level comments. For example:
-- | Pretty prints a Sudoku board encoded as a list. printGrid :: [Char] printGrid [] = ...
All top level symbols should have type signatures. Types in Haskell are super expressive and often convey as much meaning or more than variable names.
Line wrap your code at 80 or 100 characters (80 seems to be more popular). Not everybody has as wide a monitor as you, and limiting the length of your lines forces you to break up code into logical units.
Haskell programs tend to have lots of short variable names. This makes sense for general functions like map where you can't really be specific about the values even if you wanted to:
map f (x:xs) = f x : map f xs
However, the more specific your code gets the less applicable (and more confusing) short variable names get. For example, the argument to all of your functions is
x
. This a missed opportunity to give the reader more information on what the parameter of this function actual is.You are using a String to represent your Sudoku board. This is fine, but it makes your type signatures unhelpful. You can fix this by defining an alias for your board type:
-- | An entry in a Sudoku board is either the number as a -- character, or '0' to indicate an unknown value. type Entry = Char -- | A Sudoku board is a list of Sudoku entries read from -- left to right, top to bottom. type Board = [Entry]
You have several take n/drop n and takeWhile/dropWhile pairs in your code. You can combine these into a single statement with
splitAt
andspan
.front = take 9 x back = drop 9 x (front, back) = splitAt 9 x front = takeWhile (/= '0') x back = dropWhile (/= '0') x (front, back) = span (/= '0') x
You have a lot of
if-then-else
blocks in your code. Often times these can be more succinctly expressed with pattern guards. For example, you can simplify yoursolve
function as follows:-- | Takes a board with possibly unknown entries and returns -- Just a board with all of the entries containing valid numbers, -- or Nothing if there is no solution. solve :: Board -> Maybe Board solve board | isSolved board = Just board | otherwise = listToMaybe solutions where solutions = filter isSolved $ map solve (candidates board)
Also, your solve method returns the empty list if no solution can be found. This is confusing because the empty list is also a valid board. When your function has the possibility of failing, it is best to wrap the result in a Maybe or another type that is capable of representing an error.
Your
candidates
function is doing a lot of list traversals with your use of++
andtakeWhile
anddropWhile
. You can get rid of most of these traversals by using recursion to find the first element of the list and replacing it inline.-- | Generate a list of possible solutions to a Sudoku board by -- replacing the first unknown entry with all possible values. candidates board = filter isValidCandidate [ replaceFirst guess board | guess <- ['1'..'9']] -- | Replace the first unknown entry in a Sudoku board with -- the given entry. replaceFirst :: Entry -> Board -> Board replaceFirst _ [] = [] replaceFirst a ('0':xs) = a : xs replaceFirst a (x:xs) = x : replaceFirst a xs
Another note about
candidates
, you can incorporate the filter as part of the comprehension you are already doing:candidates board = [ candidate | guess <- ['1'..'9'] , candidate <- [replace guess board] , isValidCandidate candidate]
I stared at the
isInvalidCand
function for a while and I'm still having trouble groking all that is happening. Some comments and some better naming would go a long way in improving the readability this function.
-
\$\begingroup\$ Thank you! I'm not sure about your
partition (\= 0)
since I'm only trying to split at the first 0. InisInvalidCand
I'm extracting column, row and box to see if the value has already been placed. \$\endgroup\$ssh– ssh2015年05月04日 11:36:20 +00:00Commented May 4, 2015 at 11:36 -
\$\begingroup\$ Ah my bad, your right that should be
span
instead ofpartition
. \$\endgroup\$fimad– fimad2015年05月04日 14:51:19 +00:00Commented May 4, 2015 at 14:51