Sun Aug 22 10:53:30 EDT 2010

```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

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 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]
-------------- next part --------------
An HTML attachment was scrubbed...