
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]