[Haskell-cafe] Simple Sudoku solver using Control.Monad.Logic

[Daniel Fischer]

On Sunday 22 August 2010 20:12:16, Vladimir Matveev wrote:
> I think the problem is with terribly inefficient data representation.

Worse, it's a terribly inefficient algorithm.
The constraints are applied too late, so a huge number of partial boards 
are created only to be pruned afterwards. Since the ratio between obviously 
invalid rows and potentially valid rows is large, the constraints should be 
applied already during the construction of candidate rows to avoid 
obviously dead branches.

> I've written sudoku solver some time ago too using different data
> structures, including Data.Array, Data.Vector and simple lists. Lists
> are very inefficient in this case, because accessors for lists have
> O(n) complexity.

Since the lists are short, that's not so big a problem here.

> Immutable arrays from Data.Array are inefficient too,

They were pretty good for my solver. What's bad is branching.

> at least in my case - I used simple backtracking algorithm -

Which of course happens a lot in a simple backtracking algorithm.

> because
> of their immutability. Mutable arrays were slightly better, but still
> very sluggish. Then I've written two-dimensional arrays implementation
> over Data.Vector library. This was the most efficient variant -
> somewhere around 8 seconds. Of course, this implementation is mutable,
> so I have two variants, for IO and ST s monads.
> I've also written 2 versions of solving algorithm - the one that
> nearly identical to C++ imperative version using ContT monad
> transformer and very dirty foreach loop with breaking, and (as far as
> I can see) more efficient tail-recursive algorithm with ListZipper
> over free cell indices. It resembles some state machine to me, though
> I think I'm incorrect in this sense :) And it was a surprise to me:
> the tail-recursive algorithm was noticeable slower than the dirty
> imperative version! I wanted to ask about this here on haskell-cafe,
> but forgot :)
> Here is the code:
> http://hpaste.org/fastcgi/hpaste.fcgi/view?id=29364#a29364

I'll take a look.

> Profiling
> shows that the most of CPU time take modification functions like (=:). I
> don't know how to improve the performance further then.
>
> 2010/8/22 azwhaley <azwhaley at googlemail.com>:
> > Hello All,
> >
> > Apologies if some have you have got this twice but I posted this once
> > via fa.haskell on Goggle but I don't think it goes anywhere outside
> > Google.
> >
> > In an attempt to learn how to use monads, I've tried to write a simple
> > sudoku solver using the LogicT monad. I think it works but it is
> > extremely slow, in fact it won't finish at all if I attempt to enforce
> > the grid constraints. Just using row and column constraints, it will
> > finish for some problems.
> >
> > Am I doing something dreadfully wrong here or is this just a hard
> > problem to solve ?
> >
> > Thanks
> >
> > Andrew
> >
> > here's the listing :-
> >
> > module Main where
> >
> > import Control.Monad.Logic
> > import Data.List (delete, (\\))
> >
> > board :: [[Int]]
> > board = [ [7, 9, 0, 0, 0, 0, 3, 0, 0],
> >          [0, 2, 0, 0, 0, 6, 9, 0, 0],
> >          [8, 0, 0, 0, 3, 0, 0, 7, 6],
> >          [0, 0, 0, 0, 0, 5, 0, 0, 2],
> >          [0, 0, 5, 4, 1, 8, 7, 0, 0],
> >          [4, 0, 0, 7, 0, 0, 0, 0, 0],
> >          [0, 0, 0, 0, 0, 0, 0, 0, 0],
> >          [0, 0, 0, 0, 0, 0, 0, 0, 0],
> >          [0, 0, 0, 0, 0, 0, 0, 0, 0]]
> >
> > -- accessors for row, column and grid
> > row b = (b!!)
> > col b c = [x!!c | x <- b]
> > grid b g =  (t 0) ++ (t 1) ++ (t 2)
> >          where t i = take 3 $ drop x $ b !! (y + i)
> >                x   = 3 * (g `mod` 3)
> >                y   = 3 * (g `div` 3)
> >
> > -- Ensures all numbers in the list are unique
> > unique :: [Int] -> Bool
> > unique r = null (foldl (\a x -> delete x a) [x | x <- r, x /= 0]
> > [1..9])
> >
> > choose choices = msum [return x | x <- choices]
> >
> > -- Test a cell (0 = unknown value)
> > test :: Int -> Logic [Int] -> Logic Int
> > test 0 c = do choices <- c
> >              choose choices
> > test x c = return x
> >
> > -- helper to produce a diff list from a wrapped monadic list
> > mdiff :: [Logic Int] -> [Int] -> Logic [Int]
> > mdiff a c = do i <- sequence a
> >               return ([1..9]\\(i++c))
> >
> > -- the actual solver - attempts to limit choices early on by using
> > diff list of remaining values
> > sudoku :: Logic [[Int]]
> > sudoku  = do
> >          solution <- foldl (\b r -> do
> >                                      m <- b
> >                                      row <- sequence $ foldr (\(n,x) a
> > -> (test x (mdiff a $ col m n)):a) [] [(n,x) |x <- r | n <- [0..8]]
> > guard $ unique row
> >                                      sequence [guard $ unique $ col m
> > i | i <- [0..8]]
> >                                      return (m ++ [row])
> >                                        ) (return []) board
> >          sequence $ [guard $ unique $ grid solution i | i <- [0..8]]
> >          return solution
> >
> > -- solve and print
> > main = do
> >       let solution = observe sudoku
> >       sequence [print s | s <- solution]