On Sunday 22 August 2010 22:15:02, Luke Palmer wrote: > On Sun, Aug 22, 2010 at 1:18 PM, Daniel Fischer > > <daniel.is.fisc...@web.de> wrote: > > 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 a sudoku solver myself, and IIRC I used lists. It always > gave an answer within a second. So I believe Daniel has correctly > identified the problem -- you need to prune earlier.
Indeed. The below simple backtracking agorithm with early pruning finds the first solution in 0.45s here (compiled with -O2, as usual). For an empty starting board, the first solution is found in less than 0.01s. Unfortunately, I didn't understand Andrew's code enough to stay close to it, so it looks very different. {-# LANGUAGE ParallelListComp #-} module Main (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) grid b g = (take 3 . drop y) b >>= take 3 . drop x where -- t i = take 3 $ drop x $ b !! (y + i) x = 3 * (g `mod` 3) y = 3 * (g `div` 3) nextRow :: [[Int]] -> [Int] -> Logic [[Int]] nextRow b0 rw = do let rno = length b0 usd = filter (/= 0) rw pss = [1 .. 9] \\ usd u = 3*(rno `quot` 3) opp yes no (n,0) = let cl = col b0 n gd = grid b0 (u + n `quot` 3) in msum . map return $ yes \\ (cl ++ gd) opp _ _ (n,x) = let cl = col b0 n gd = grid b0 (u + n `quot` 3) in guard (x `notElem` (cl ++gd)) >> return x -- The above is essential. Since we only look at previous rows, -- we must check whether a given value violates the constraints foo _ no [] = return no foo yes no (p:ps) = do d <- opp yes no p foo (delete d yes) (no ++ [d]) ps row <- (foo pss [] $ zip [0 .. 8] rw) return (b0 ++ [row]) -- the actual solver sudoku :: Logic [[Int]] sudoku = go [] board where go b (r:rs) = do b1 <- nextRow b r go b1 rs go b [] = return b -- solve and print main = do let solution = observe sudoku sequence_ [print s | s <- solution] _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe