Re: [Haskell-cafe] Simple Sudoku solver using Control.Monad.Logic
On Aug 22, 2010, at 11:09 PM, Vladimir Matveev wrote: are there any materials except LogicT.pdf from link on the logict hackage entry? I'd like to read something on this interesting topic The functional pearl A program to solve Sudoku by Richard Bird http://www.cs.tufts.edu/~nr/comp150fp/archive/richard-bird/ sudoku.pdf is an interesting read. If you get your hands on a copy of The Fun of Programming, which has been edited in honour of Richard Birds 60th birthday, you can have a look at Chapter 9, Combinators for logic programming by Mike Spivey and Silvija Seres I did not find this chapter online. Issue 15 of the Monad.Reader contains Adventures in Three Monads by Edward Z. Yang http://themonadreader.files.wordpress.com/2010/01/issue15.pdf which gives an introduction to the Logic monad (and two others). In my doctoral thesis I give a brief introduction to nondeterminism monads in general and how to implement some specific instances: On Functional-Logic Programming and its Application to Testing by Sebastian Fischer Section 5.1, Nondeterminism monads http://www-ps.informatik.uni-kiel.de/~sebf/thesis.pdf There are various nondeterminism monads on Hackage. If you restrict your algorithm to only use the MonadPlus interface you can experiment with all of them simply by changing a type signature. The list monad (not on Hackage because defined in the Prelude) implements backtracking via depth-first search. The Hackage package control-monad-omega [1] by Luke Palmer uses list diagonalisation to overcome limitations of the list monad. It is described to implement breadth-first search which, in my opinion, it doesn't exactly. My package level-monad [2] provides monads for iterative deepening depth-first search and breadth-first search. The latter enumerates results of the search space in breadth-first (that is level) order. The former does something similar with better space usage. The different implementations of nondeterminism monads often differ significantly in how much memory they use. The list monad uses little memory but often diverges when the search space is infinite. Breadth- first search is a complete strategy (it does not diverge infinite search spaces and, thus, eventually finds every result) but has excessive memory requirements. Oleg Kiselyov has invented a complete strategy with moderate memory requirements which I have packaged as stream-monad [3]. I recommend using the list or logic monad if the search space is finite and the stream monad or iterative deepening dfs if the search space is infinite. Cheers, Sebastian [1]: http://hackage.haskell.org/package/control-monad-omega [2]: http://hackage.haskell.org/package/level-monad [3]: http://hackage.haskell.org/package/stream-monad -- Underestimating the novelty of the future is a time-honored tradition. (D.G.) ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Simple Sudoku solver using Control.Monad.Logic
Many thanks. This is very useful :) 2010/8/23 Sebastian Fischer s...@informatik.uni-kiel.de: On Aug 22, 2010, at 11:09 PM, Vladimir Matveev wrote: are there any materials except LogicT.pdf from link on the logict hackage entry? I'd like to read something on this interesting topic The functional pearl A program to solve Sudoku by Richard Bird http://www.cs.tufts.edu/~nr/comp150fp/archive/richard-bird/sudoku.pdf is an interesting read. If you get your hands on a copy of The Fun of Programming, which has been edited in honour of Richard Birds 60th birthday, you can have a look at Chapter 9, Combinators for logic programming by Mike Spivey and Silvija Seres I did not find this chapter online. Issue 15 of the Monad.Reader contains Adventures in Three Monads by Edward Z. Yang http://themonadreader.files.wordpress.com/2010/01/issue15.pdf which gives an introduction to the Logic monad (and two others). In my doctoral thesis I give a brief introduction to nondeterminism monads in general and how to implement some specific instances: On Functional-Logic Programming and its Application to Testing by Sebastian Fischer Section 5.1, Nondeterminism monads http://www-ps.informatik.uni-kiel.de/~sebf/thesis.pdf There are various nondeterminism monads on Hackage. If you restrict your algorithm to only use the MonadPlus interface you can experiment with all of them simply by changing a type signature. The list monad (not on Hackage because defined in the Prelude) implements backtracking via depth-first search. The Hackage package control-monad-omega [1] by Luke Palmer uses list diagonalisation to overcome limitations of the list monad. It is described to implement breadth-first search which, in my opinion, it doesn't exactly. My package level-monad [2] provides monads for iterative deepening depth-first search and breadth-first search. The latter enumerates results of the search space in breadth-first (that is level) order. The former does something similar with better space usage. The different implementations of nondeterminism monads often differ significantly in how much memory they use. The list monad uses little memory but often diverges when the search space is infinite. Breadth-first search is a complete strategy (it does not diverge infinite search spaces and, thus, eventually finds every result) but has excessive memory requirements. Oleg Kiselyov has invented a complete strategy with moderate memory requirements which I have packaged as stream-monad [3]. I recommend using the list or logic monad if the search space is finite and the stream monad or iterative deepening dfs if the search space is infinite. Cheers, Sebastian [1]: http://hackage.haskell.org/package/control-monad-omega [2]: http://hackage.haskell.org/package/level-monad [3]: http://hackage.haskell.org/package/stream-monad -- Underestimating the novelty of the future is a time-honored tradition. (D.G.) ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
[Haskell-cafe] Simple Sudoku solver using Control.Monad.Logic
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] ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Simple Sudoku solver using Control.Monad.Logic
I think the problem is with terribly inefficient data representation. 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. Immutable arrays from Data.Array are inefficient too, at least in my case - I used 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 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 azwha...@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] ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Simple Sudoku solver using Control.Monad.Logic
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 azwha...@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] ___ Haskell-Cafe mailing list
Re: [Haskell-cafe] Simple Sudoku solver using Control.Monad.Logic
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. Luke ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Simple Sudoku solver using Control.Monad.Logic
Thanks for explanation. One more question: are there any materials except LogicT.pdf from link on the logict hackage entry? I'd like to read something on this interesting topic because the above code looks kinda obfuscated to me :) ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Simple Sudoku solver using Control.Monad.Logic
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
