Hello All,<br>
<br>
Apologies if some have you have got this twice but I posted this once<br>
via fa.haskell on Goggle but I don't think it goes anywhere outside<br>
Google.<br>
<br>
In an attempt to learn how to use monads, I've tried to write a simple<br>
sudoku solver using the LogicT monad. I think it works but it is<br>
extremely slow, in fact it won't finish at all if I attempt to enforce<br>
the grid constraints. Just using row and column constraints, it will<br>
finish for some problems.<br>
<br>
Am I doing something dreadfully wrong here or is this just a hard<br>
problem to solve ?<br>
<br>
Thanks<br>
<br>
Andrew<br>
<br>
here's the listing :-<br>
<br>
module Main where<br>
<br>
import Control.Monad.Logic<br>
import Data.List (delete, (\\))<br>
<br>
board :: [[Int]]<br>
board = [ [7, 9, 0, 0, 0, 0, 3, 0, 0],<br>
[0, 2, 0, 0, 0, 6, 9, 0, 0],<br>
[8, 0, 0, 0, 3, 0, 0, 7, 6],<br>
[0, 0, 0, 0, 0, 5, 0, 0, 2],<br>
[0, 0, 5, 4, 1, 8, 7, 0, 0],<br>
[4, 0, 0, 7, 0, 0, 0, 0, 0],<br>
[0, 0, 0, 0, 0, 0, 0, 0, 0],<br>
[0, 0, 0, 0, 0, 0, 0, 0, 0],<br>
[0, 0, 0, 0, 0, 0, 0, 0, 0]]<br>
<br>
-- accessors for row, column and grid<br>
row b = (b!!)<br>
col b c = [x!!c | x <- b]<br>
grid b g = (t 0) ++ (t 1) ++ (t 2)<br>
where t i = take 3 $ drop x $ b !! (y + i)<br>
x = 3 * (g `mod` 3)<br>
y = 3 * (g `div` 3)<br>
<br>
-- Ensures all numbers in the list are unique<br>
unique :: [Int] -> Bool<br>
unique r = null (foldl (\a x -> delete x a) [x | x <- r, x /= 0] [1..9])<br>
<br>
choose choices = msum [return x | x <- choices]<br>
<br>
-- Test a cell (0 = unknown value)<br>
test :: Int -> Logic [Int] -> Logic Int<br>
test 0 c = do choices <- c<br>
choose choices<br>
test x c = return x<br>
<br>
-- helper to produce a diff list from a wrapped monadic list<br>
mdiff :: [Logic Int] -> [Int] -> Logic [Int]<br>
mdiff a c = do i <- sequence a<br>
return ([1..9]\\(i++c))<br>
<br>
-- the actual solver - attempts to limit choices early on by using<br>
diff list of remaining values<br>
sudoku :: Logic [[Int]]<br>
sudoku = do<br>
solution <- foldl (\b r -> do<br>
m <- b<br>
row <- sequence $ foldr (\(n,x) a -> (test x (mdiff a $ col m n)):a) [] [(n,x) |x <- r | n <- [0..8]]<br>
guard $ unique row<br>
sequence [guard $ unique $ col m i | i <- [0..8]]<br>
return (m ++ [row])<br>
) (return []) board<br>
sequence $ [guard $ unique $ grid solution i | i <- [0..8]]<br>
return solution<br>
<br>
-- solve and print<br>
main = do<br>
let solution = observe sudoku<br>
sequence [print s | s <- solution]<div style="visibility: hidden; display: inline;" id="avg_ls_inline_popup"></div><style type="text/css">#avg_ls_inline_popup { position:absolute; z-index:9999; padding: 0px 0px; margin-left: 0px; margin-top: 0px; width: 240px; overflow: hidden; word-wrap: break-word; color: black; font-size: 10px; text-align: left; line-height: 13px;}</style>