3
\$\begingroup\$

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 
\$\endgroup\$
  • \$\begingroup\$ Have you seen this Sudoku in Haskell functional pearl by Graham Hutton? It's a thing of beauty. \$\endgroup\$ – bisserlis Apr 26 '15 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 Apr 26 '15 at 13:14
5
\$\begingroup\$

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 and span.

    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 your solve 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 ++ and takeWhile and dropWhile. 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.

\$\endgroup\$
  • \$\begingroup\$ Thank you! I'm not sure about your partition (\= 0) since I'm only trying to split at the first 0. In isInvalidCand I'm extracting column, row and box to see if the value has already been placed. \$\endgroup\$ – ssh May 4 '15 at 11:36
  • \$\begingroup\$ Ah my bad, your right that should be span instead of partition. \$\endgroup\$ – fimad May 4 '15 at 14:51

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.