Haskell kenken debugging

Programming in Haskell requires a different kind of debugging process. Some debugging can be eased by using something like quickcheck and Hat provides tracing facilities. I've used both of these and quite like quickcheck as it provides a nice way to check low level code. I usually find though that I'd like to do some (often selective) printing of specific information in a format that I can easily scan and interpret. I often spend a fair amount of time building output that is easy to look at as doing that both helps me debug and helps me to ensure that I understand what it is I'm trying to do.

In a language like C you can just dump in printfs here and there (usually controlled by some debug value either defined at the preprocessor level or in the language). But in Haskell it is much harder to just dump IO statements in at random points in the code unless that code is in the IO monad.

In this code, I've used the state transformer monad on top of the IO monad for the highest level of code, so the IO monad is available. To get the same effect as in C where I can turn on and off such statements by changing the value of a variable, I've built some low level helper functions. The essential part of the code is :

debug = False 

dbPutLn :: String -> PuzzleM () 
dbPutLn s = if debug then  liftIO $ putStrLn s else return () 

Because of the liftIO this needs to be run in the appropriate monadic environment, but thats not a problem here.

Along with that I've also constructed a way to print multiple lines with a label and so that the label lies up against the left hand side of the output and the lines all are indented a bit. This makes the output easier (for me at least) to scan for interesting occurrences. Typical output might look like :

in function foo
    value1=1
    value2=2

And the code for this looks like :

dbPutLabeledLines :: String -> [String] -> PuzzleM ()
dbPutLabeledLines label ls = if debug 
                                then do 
                                  liftIO $ putStrLn ""
                                  liftIO $ putStrLn label 
                                  mapM_ (liftIO . putIndentedLine) ls 
                                else return () 
   where 
         putIndentedLine l = putStrLn $ "   " ++ l

On a side note, languages that provide support for pre-conditions, post-conditions and class invariants (such as Eiffel and the sadly defunct Sather) are, for me anyway, about the best thing around for building correct code. Not only can good pre/post-conditions make debugging easier (especially with a good test suite and a good way to generate test cases), but they also help me decide just what it is that the code needs to do and they provide invaluable information when I read the code to see what it does.

more kenken

My second kenken program is a bit longer and more complex. At the base is the old kenken program (see this post).

This program though tries to eliminate possibilities on each cell as it goes. There is a structure that ties cells to the set of possibilities that are currently available for that cell :

data CellPos = CellPos { 
       cpcell :: Cell, 
       cposs  :: [Int] 
     } deriving (Eq, Show)

These are all initialized at start up so that cposs contains the list of integers [1..size of puzzle], then as possible assignments for cells are explored, each such assignment is used to try to reduce the possibilities in each of these structures.

The solve function then :

• finds all of the cells with only one possibility and makes all those assignments
  
• sorts the cells with multiple possibilities so those with the fewest number of possibilities come first
  
• tries making all the assignments currently possible with the first cell (which will be one of those with the fewest possibilities still available)
  
• returns all solutions found.
  

Another difference (as noted above) is that this solver will try to find all possible solutions for a puzzle instead of just the first.

Here is the solve function (stripped of debug prints) :

solve cpl assList resultList = do 
  puz <- getPuzzle 
  s <- getSize 

  let sortedPossibilities = sortBy comparer cpl
      comparer x y        = compare (pcount x) (pcount y)
      uhOh                =   null sortedPossibilities  -- no assignments possible ?? 
                           || 0 == pcount (head sortedPossibilities) 

  -- if no assignments possible from here, just return the result list 
  -- otherwise if there are ways to do a single assignment (so the possiblity
  -- list for a cell contains only one value), do all of those 
  -- then double check to see if it is all possible, if so call solve recursively
  if uhOh 
    then return resultList  
    else do 
      let 
          oneChoices          = filter (\x -> 1 == pcount x) sortedPossibilities 
          newAssignments      = makeAssignments oneChoices 
          multiChoices        = filter (\x -> 1 < pcount x)  sortedPossibilities 
          currentAssignments  = assList ++ newAssignments 

      ok <- verify currentAssignments

      if not ok 
        then do return resultList -- verify failed 
        else if null multiChoices 
                then return $ currentAssignments:resultList 
                else if length newAssignments > 0  
                        then do  -- new assignments to do, try them 

                          constraints <- getConstraints 
                          let constrainedPossibilities = foldr (updateRCPossibilities currentAssignments constraints) multiChoices newAssignments

                          solve constrainedPossibilities currentAssignments resultList 
                        else do 
                               let 
                                  nextCell            = head multiChoices 
                                  needAssignments     = tail multiChoices 
                                  nextAssignments     = map (\x -> Assignment{ acell = cpcell nextCell, avalue=x}) $ cposs nextCell


                               -- now we have a cell with several possibilities, try each of those in sequence 
                               maybeRes <- mapM (\x -> solveWithAssignment x needAssignments currentAssignments []) nextAssignments 
                               return $ resultList ++ (concat $ filter (not.null) maybeRes) 

anagrams

I let my anagrams program run for a while trying to find anagrams for "eastern washington university". I killed it after it had produced 60 million anagrams and 5.9Gb of output. At that point all of the lines still started with :

[["a"],["a"] ... 

On another note, the Tour De France has started again. I used to do a fair amount of cycling (but no racing) so have been watching this now for a while and in the last couple of years have found it increasingly fun. It helps that Versus shows several hours of it in the morning pretty much as it happens - so not only do you get to watch the race, but you also get to look at the French (and Italian and Spanish and ...) countryside. The later broadcasts focus more on the race and especially on the American riders, which gets substantially less interesting for me - I enjoy watching them all battle it out and watching the soap opera of who gets to win (and who gets to win the various jerseys) unfold over the course of three weeks or so.