Sudoku Solver
Frank Buss
letter to the editor of the german issue of Scientific American, because
the author of an article about Sudoku wrote, that it is possible to write a
solver in a few hundred lines of Prolog, so I thought it is a good idea to
write it in 50 lines of Common Lisp :-)
http://www.frank-buss.de/lisp/sudoku.html
--
Frank Buss, f...@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
Pea...@gmail.com
Thanks Frank, your version is easier to understand than this one, which
may be faster but longer and more difficult to grok for me:
Marcin 'Qrczak' Kowalczyk
> Just a minor cleanup of the code I wrote some months ago, because
> I wrote a letter to the editor of the german issue of Scientific
> American, because the author of an article about Sudoku wrote, that
> it is possible to write a solver in a few hundred lines of Prolog,
> so I thought it is a good idea to write it in 50 lines of Common
> Lisp :-)
>
> http://www.frank-buss.de/lisp/sudoku.html
I translated it straightforwardly to my language Kogut.
It came a little bit shorter:
http://cvs.sourceforge.net/viewcvs.py/kokogut/kokogut/examples/small/Sudoku.ko?view=markup
--
__("< Marcin Kowalczyk
\__/ qrc...@knm.org.pl
^^ http://qrnik.knm.org.pl/~qrczak/
Jon Harrop
> Just a minor cleanup of the code I wrote some months ago, because I wrote
> a letter to the editor of the german issue of Scientific American, because
> the author of an article about Sudoku wrote, that it is possible to write
> a solver in a few hundred lines of Prolog, so I thought it is a good idea
> to write it in 50 lines of Common Lisp :-)
>
> http://www.frank-buss.de/lisp/sudoku.html
Wow, that's huge! You should try writing a short program. ;-)
http://www.ffconsultancy.com/free/sudoku
--
Dr Jon D Harrop, Flying Frog Consultancy Ltd.
http://www.ffconsultancy.com/products/ocaml_for_scientists/chapter1.html
Wade Humeniuk
> Frank Buss <f...@frank-buss.de> writes:
>
>> Just a minor cleanup of the code I wrote some months ago, because
>> I wrote a letter to the editor of the german issue of Scientific
>> American, because the author of an article about Sudoku wrote, that
>> it is possible to write a solver in a few hundred lines of Prolog,
>> so I thought it is a good idea to write it in 50 lines of Common
>> Lisp :-)
>>
>> http://www.frank-buss.de/lisp/sudoku.html
>
> I translated it straightforwardly to my language Kogut.
> It came a little bit shorter:
>
> http://cvs.sourceforge.net/viewcvs.py/kokogut/kokogut/examples/small/Sudoku.ko?view=markup
>
Editing Frank's slightly we can get, (30 lines)
(defun digits-in-region (sudoku x y)
(loop repeat 3 for x from (* 3 (floor x 3))
append (loop repeat 3 for y from (* 3 (floor y 3))
for digit = (aref sudoku y x)
unless (zerop digit) collect digit)))
(defun digits-in-row (sudoku y)
(remove-if #'zerop (loop for x from 0 below 9 collect (aref sudoku y x))))
(defun digits-in-column (sudoku x)
(remove-if #'zerop (loop for y from 0 below 9 collect (aref sudoku y x))))
(defun create-missing (list)
(set-difference '(1 2 3 4 5 6 7 8 9) list))
(defun possible-digits (sudoku x y)
(create-missing
(union
(digits-in-region sudoku x y)
(union (digits-in-row sudoku y)
(digits-in-column sudoku x)))))
(defun solve-next (sudoku x y)
(when (= y 9) (throw 'done sudoku))
(multiple-value-bind (nextx nexty)
(if (< x 8) (values (1+ x) y) (values 0 (1+ y)))
(if (/= 0 (aref sudoku y x))
(solve-next sudoku nextx nexty)
(dolist (digit (possible-digits sudoku x y))
(setf (aref sudoku y x) digit)
(solve-next sudoku nextx nexty)
(setf (aref sudoku y x) 0)))))
(defun solve (sudoku)
(pprint (catch 'done
(solve-next (make-array '(9 9) :initial-contents sudoku) 0 0))))
CL-USER 30 > (time (solve '((0 0 2 3 0 0 7 0 0)
(0 0 4 0 0 9 0 0 0)
(6 0 0 0 0 0 0 5 0)
(0 7 0 0 0 2 0 6 0)
(0 0 3 7 0 0 4 0 0)
(0 1 0 0 0 0 0 2 0)
(0 3 0 0 0 0 0 0 9)
(0 0 0 4 0 0 6 0 0)
(0 0 5 0 0 8 2 0 0))))
Timing the evaluation of (SOLVE (QUOTE ((0 0 2 3 0 0 7 0 0) (0 0 4 0 0 9 0 0 0) (6 0 0 0 0
0 0 5 0) (0 7 0 0 0 2 0 6 0) (0 0 3 7 0 0 4 0 0) (0 1 0 0 0 0 0 2 0) (0 3 0 0 0 0 0 0 9)
(0 0 0 4 0 0 6 0 0) (0 0 5 0 0 8 2 0 0))))
#2A((1 8 2 3 5 6 7 9 4)
(3 5 4 2 7 9 8 1 6)
(6 9 7 8 1 4 3 5 2)
(4 7 9 5 8 2 1 6 3)
(2 6 3 7 9 1 4 8 5)
(5 1 8 6 4 3 9 2 7)
(8 3 6 1 2 7 5 4 9)
(9 2 1 4 3 5 6 7 8)
(7 4 5 9 6 8 2 3 1))
user time = 0.260
system time = 0.000
Elapsed time = 0:00:00
Allocation = 4240 bytes standard / 6672017 bytes conses
0 Page faults
Calls to %EVAL 34
CL-USER 31 >
Wade Humeniuk
(defun digits-in-region (sudoku x y)
(loop repeat 3 for x from (* 3 (floor x 3))
append (loop repeat 3 for y from (* 3 (floor y 3))
collect (aref sudoku y x))))
(defun digits-in-row (sudoku y)
(loop for x from 0 below 9 collect (aref sudoku y x)))
(defun digits-in-column (sudoku x)
(loop for y from 0 below 9 collect (aref sudoku y x)))
(defun remove-zeros (list) (remove-if #'zerop list))
(defun possible-digits (sudoku x y)
(set-difference
'(1 2 3 4 5 6 7 8 9)
(remove-zeros
(union (digits-in-region sudoku x y)
(union (digits-in-row sudoku y)
(digits-in-column sudoku x))))))
Raffael Cavallaro
> Wow, that's huge! You should try writing a short program. ;-)
It is worth noting that Dr. Harrop is selling a book that advocates the
use of Ocaml in scientific computing for £85.
Majorinc
reader03.plus.net>, use...@jdh30.plus.com says...
>
> Wow, that's huge! You should try writing a short program. ;-)
>
> http://www.ffconsultancy.com/free/sudoku
Lisp users should see your program as a good argument for
counting tokens (including parens) instead of lines.
Jon Harrop
> Lisp users should see your program as a good argument for
> counting tokens (including parens) instead of lines.
I can justify counting LOC (because you have to sift through code line-by-
line whilst programming) and bytes (because you have to type code in almost
byte-by-byte) but tokens don't seem very relevant.
I'd have thought the Lisp versions could be made a lot smaller though.
Wade's latest is 1203 bytes but it doesn't input the puzzle. Also, I'm not
sure if the algorithms are the same. Considering this is a task ill-suited
to functional programming, I think we're doing well... :-)
It might also be interesting to compare performance - the OCaml program is
crippled because ocamlopt does not optimise integer / and mod. That's
easily circumvented by writing your own specialised routines, but who wants
to do that.
With the current code I'm getting 0.310s for CMUCL and 0.212s for ocamlopt
on AMD32, and 0.197s for SBCL and 0.130s for ocamlopt on AMD64. On a
different puzzle I get 3.914s for SBCL and 2.835s for ocamlopt on AMD64.
So performance is comparable and, of course, vastly worse than a "proper"
solver.
I'll try writing an SML version...
Wade Humeniuk
>
> With the current code I'm getting 0.310s for CMUCL and 0.212s for ocamlopt
> on AMD32, and 0.197s for SBCL and 0.130s for ocamlopt on AMD64. On a
> different puzzle I get 3.914s for SBCL and 2.835s for ocamlopt on AMD64.
>
Try this faster version... (almost twice as fast)
(defun digits-in-region (sudoku x y)
(loop repeat 3 for x from (* 3 (floor x 3))
nconc (loop repeat 3 for y from (* 3 (floor y 3))
collect (aref sudoku y x))))
(defun digits-in-row (sudoku y)
(loop for x from 0 below 9 collect (aref sudoku y x)))
(defun digits-in-column (sudoku x)
(loop for y from 0 below 9 collect (aref sudoku y x)))
(defun possible-digits (sudoku x y)
(set-difference
'(1 2 3 4 5 6 7 8 9)
(nconc (digits-in-region sudoku x y)
(digits-in-row sudoku y)
(digits-in-column sudoku x))))
(defun solve-next (sudoku x y)
Pea...@gmail.com
Wade Humeniuk wrote:
> Try this faster version... (almost twice as fast)
>
> (defun digits-in-region (sudoku x y)
> (loop repeat 3 for x from (* 3 (floor x 3))
> nconc (loop repeat 3 for y from (* 3 (floor y 3))
> collect (aref sudoku y x))))
Wade, LispWorks Personal Edition runs it fine, but CLISP is giving me
warnings at compile time with (defun digits-in-region ...) and errors
at runtime. I don't know enough about either clisp or loop to know
what the problem is. Could you enlighten me?
Here is the clisp warning:
WARNING in DIGITS-IN-REGION :
variable X is not used.
Misspelled or missing IGNORE declaration?
WARNING in DIGITS-IN-REGION :
variable Y is not used.
Misspelled or missing IGNORE declaration?
Alex Mizrahi
(you :wrote :on '(Tue, 21 Feb 2006 13:51:29 +0000))
(
??>> Lisp users should see your program as a good argument for
??>> counting tokens (including parens) instead of lines.
JH> I can justify counting LOC (because you have to sift through code
JH> line-by- line whilst programming) and bytes (because you have to type
JH> code in almost byte-by-byte) but tokens don't seem very relevant.
Paul Graham thinks they are (if i understood correctly)
http://www.paulgraham.com/power.html
)
(With-best-regards '(Alex Mizrahi) :aka 'killer_storm)
"People who lust for the Feel of keys on their fingertips (c) Inity")
Wade Humeniuk
> Wade Humeniuk wrote:
>> Try this faster version... (almost twice as fast)
>>
>> (defun digits-in-region (sudoku x y)
>> (loop repeat 3 for x from (* 3 (floor x 3))
>> nconc (loop repeat 3 for y from (* 3 (floor y 3))
>> collect (aref sudoku y x))))
>
> Wade, LispWorks Personal Edition runs it fine, but CLISP is giving me
> warnings at compile time with (defun digits-in-region ...) and errors
> at runtime. I don't know enough about either clisp or loop to know
> what the problem is. Could you enlighten me?
>
Probably something to do with variable capturing. Try this instead
(defun digits-in-region (sudoku xb yb)
(loop repeat 3 for x from (* 3 (floor xb 3))
nconc (loop repeat 3 for y from (* 3 (floor yb 3))
Pea...@gmail.com
ana...@earthlink.net
> I can justify counting LOC (because you have to sift through code line-by-
> line whilst programming) and bytes (because you have to type code in almost
> byte-by-byte) but tokens don't seem very relevant.
Given reasonable line-breaks, tokens/phrases are the right metric for
reading
because programming rarely involves the equivalent of "sounding out" a
word.
Tokens/phrases are also reasonable for writing because that's where the
thought
comes in. Yes, tokens are made up of keystrokes, but for reasonable
token-length,
especially given a reasonable dev environment, the number of keystrokes
is
only slightly more relevant than the number of electrons moved.
-andy
Bob Felts
[...]
>
> With the current code I'm getting 0.310s for CMUCL and 0.212s for ocamlopt
> on AMD32, and 0.197s for SBCL and 0.130s for ocamlopt on AMD64. On a
> different puzzle I get 3.914s for SBCL and 2.835s for ocamlopt on AMD64.
>
> So performance is comparable and, of course, vastly worse than a "proper"
> solver.
>
> I'll try writing an SML version...
I wrote a soduko solver this weekend (one of my "learning Lisp"
exercises) that does 1,000,000 boards (well, the same board 1 million
times) in 33 seconds (.00003s/board) running OpenMCL under AquaEmacs +
Slime on a 1GHz PowerBook w/ 1GB memory.
Patrick May
> Just a minor cleanup of the code I wrote some months ago, because I
> wrote a letter to the editor of the german issue of Scientific
> American, because the author of an article about Sudoku wrote, that
> it is possible to write a solver in a few hundred lines of Prolog,
> so I thought it is a good idea to write it in 50 lines of Common
> Lisp :-)
>
> http://www.frank-buss.de/lisp/sudoku.html
Nice, clean, concise, but so mechanical. My version solves it
like a human would, although it takes a few (hundred) more lines:
http://www.spe.com/pjm/sudoku.lisp
Regards,
Patrick
------------------------------------------------------------------------
S P Engineering, Inc. | The experts in large scale distributed OO
| systems design and implementation.
p...@spe.com | (C++, Java, Jini, CORBA, UML)
Jon Harrop
> I wrote a soduko solver this weekend (one of my "learning Lisp"
> exercises) that does 1,000,000 boards (well, the same board 1 million
> times) in 33 seconds (.00003s/board) running OpenMCL under AquaEmacs +
> Slime on a 1GHz PowerBook w/ 1GB memory.
What puzzle are you solving and how much code is there?
These implementations run at that speed if you remove only the (0,0) element
from an otherwise solved puzzle...
Jon Harrop
> Try this faster version... (almost twice as fast)
I get 0.26s for the OP's puzzle (compared to 0.31s before).
Jon Harrop
> JH> I can justify counting LOC (because you have to sift through code
> JH> line-by- line whilst programming) and bytes (because you have to type
> JH> code in almost byte-by-byte) but tokens don't seem very relevant.
>
> Paul Graham thinks they are (if i understood correctly)
>
> http://www.paulgraham.com/power.html
I prefer Andy's justifications for counting tokens and, had I written that
article, I'd have titled it "Brevity is Power". ;-)
An obvious problem is the definition of a token. For example, how many
tokens are there in the OCaml "~x:(i+1)"? I thought "~ x : ( i + 1 )" but
that doesn't compile so I think it is "~x: ( i + 1 )". This illustrates the
irrelevancy of tokens from the point of view of the programmer - we don't
know or care what constitutes a token.
Perhaps those justifications are more appropriate for counting words, but
then you can omit whitespace in languages like OCaml, to get a few giant
words...
Ok, how many tokens are there in the smallest Lisp implementation? I think
my OCaml has 298 and Wade's Lisp has 302.
Alexander Schmolck
> This illustrates the irrelevancy of tokens from the point of view of the
> programmer - we don't know or care what constitutes a token.
Only if the language doesn't support syntactic abstraction.
'as
ana...@earthlink.net
> An obvious problem is the definition of a token.
Nope - token defined by the language. The uncertainty is in the
definition
of "phrase", aka idiom. For example, some people read "(defun" as two
things while others read it as one.
Some phrases can be identified by a lack of redundant spaces. That
lack
helps people read them as one phrase. For example, consider "( defun";
the extra space may break some folks' "(defun" phrase recognizer.
Jon Harrop
Both Lisp and OCaml support syntactic abstraction but token counts seem much
more applicable to Lisp than they do to OCaml. Lines seem more applicable
to OCaml but less applicable to Lisp because they're almost essential for
clarifying code. Word counts are too erroneous in OCaml because of optional
whitespace. That leaves bytes which, as other people have noted, aren't
great either.
If you want to compare with languages like Mathematica then you're totally
stuffed - everything is typeset in 2D. Maybe keypresses but then you're
looking at the IDE more than the language?!
Wade and I have already tried "time spent programming" but that is hardly
practicable.
I think the only conclusion we can draw is that the OCaml and Lisp (and
probably SML) are close enough. However, the C is probably close enough as
well. ;-)
Jon Harrop
Then you're advocating that I root through the OCaml compiler's lexer to
find out how it happens to interpret characters as tokens. That implies to
me that tokens aren't very relevant to the programmer.
Bob Felts
> Bob Felts wrote:
> > I wrote a soduko solver this weekend (one of my "learning Lisp"
> > exercises) that does 1,000,000 boards (well, the same board 1 million
> > times) in 33 seconds (.00003s/board) running OpenMCL under AquaEmacs +
> > Slime on a 1GHz PowerBook w/ 1GB memory.
>
> What puzzle are you solving and how much code is there?
I was solving today's puzzle in my local newspaper:
Row 1: --9183--4
Row 2: -----5829
Row 3: 486------
Row 4: 8---5-39-
Row 5: -6-849-1-
Row 6: -97-2---8
Row 7: ------467
Row 8: 5216-----
Row 9: 6--9382--
It's rated as the least difficult.
I didn't do as well with the puzzle at
http://www.ffconsultancy.com/free/sudoku/
It took 44.505 seconds to solve 10,000 iterations of that board (0.0045
sec/board).
>
> These implementations run at that speed if you remove only the (0,0) element
> from an otherwise solved puzzle...
As for code, there 207 total lines, broadly grouped as:
41 comments
31 lines for a data table
46 lines to interactively read and validate a board
51 lines to solve the puzzle
---------
169
Whitespace, and some minor bookkeeping code comprises the rest.
I'm still tweaking, however. I've only been using Lisp for a couple of
weeks and I'm still trying to improve my style.
Wade Humeniuk
> Wade Humeniuk wrote:
>> Try this faster version... (almost twice as fast)
>
> I get 0.26s for the OP's puzzle (compared to 0.31s before).
>
Hmmm, here is one that runs about 10x faster than my original. (Even
with the declares removed it runs in .07s on my machine.)
(defun make-sudoku-set () (make-array 10 :element-type 'bit :initial-element 0))
(defun digits-in-region (set sudoku x y &aux (xstart (* 3 (floor x 3)))
(ystart (* 3 (floor y 3))))
(declare (optimize (speed 3) (safety 0) (debug 0))
(type bit-vector set) (type (simple-array unsigned-byte (9 9)) sudoku))
(loop repeat 3 for x from xstart do
(loop repeat 3 for y from ystart do
(setf (bit set (aref sudoku y x)) 1))))
(defun digits-in-row (set sudoku y)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type bit-vector set) (type (simple-array unsigned-byte (9 9)) sudoku))
(loop for x from 0 below 9 do (setf (bit set (aref sudoku y x)) 1)))
(defun digits-in-column (set sudoku x)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type bit-vector set) (type (simple-array unsigned-byte (9 9)) sudoku))
(loop for y from 0 below 9 do (setf (bit set (aref sudoku y x)) 1)))
(defun possible-digits (sudoku x y)
(let ((set (make-sudoku-set)))
(declare (optimize (speed 3) (safety 0) (debug 0))
(type bit-vector set) (type (simple-array unsigned-byte (9 9)) sudoku))
(digits-in-region set sudoku x y)
(digits-in-row set sudoku y)
(digits-in-column set sudoku x)
set))
(defun solve-next (sudoku x y)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type (simple-array unsigned-byte (9 9)) sudoku))
(when (= y 9) (throw 'done sudoku))
(multiple-value-bind (nextx nexty)
(if (< x 8) (values (1+ x) y) (values 0 (1+ y)))
(if (/= 0 (aref sudoku y x))
(solve-next sudoku nextx nexty)
(let ((possible (possible-digits sudoku x y)))
(declare (type bit-vector possible))
(loop for digit from 1 to 9
when (zerop (bit possible digit)) do
(setf (aref sudoku y x) digit)
(solve-next sudoku nextx nexty)
(setf (aref sudoku y x) 0))))))
(defun solve (sudoku)
(pprint (catch 'done
(solve-next (make-array '(9 9) :element-type 'unsigned-byte
:initial-contents sudoku) 0 0))))
CL-USER 29 > (time (solve '((0 0 2 3 0 0 7 0 0)
(0 0 4 0 0 9 0 0 0)
(6 0 0 0 0 0 0 5 0)
(0 7 0 0 0 2 0 6 0)
(0 0 3 7 0 0 4 0 0)
(0 1 0 0 0 0 0 2 0)
(0 3 0 0 0 0 0 0 9)
(0 0 0 4 0 0 6 0 0)
(0 0 5 0 0 8 2 0 0))))
Timing the evaluation of (SOLVE (QUOTE ((0 0 2 3 0 0 7 0 0) (0 0 4 0 0 9 0 0 0) (6 0 0 0 0
0 0 5 0) (0 7 0 0 0 2 0 6 0) (0 0 3 7 0 0 4 0 0) (0 1 0 0 0 0 0 2 0) (0 3 0 0 0 0 0 0 9)
(0 0 0 4 0 0 6 0 0) (0 0 5 0 0 8 2 0 0))))
#2A((1 8 2 3 5 6 7 9 4)
(3 5 4 2 7 9 8 1 6)
(6 9 7 8 1 4 3 5 2)
(4 7 9 5 8 2 1 6 3)
(2 6 3 7 9 1 4 8 5)
(5 1 8 6 4 3 9 2 7)
(8 3 6 1 2 7 5 4 9)
(9 2 1 4 3 5 6 7 8)
(7 4 5 9 6 8 2 3 1))
user time = 0.040
system time = 0.000
Elapsed time = 0:00:00
Allocation = 196568 bytes standard / 957 bytes conses
0 Page faults
Calls to %EVAL 34
CL-USER 30 >
Pea...@gmail.com
Wade Humeniuk wrote:
> Jon Harrop wrote:
> > Wade Humeniuk wrote:
> >> Try this faster version... (almost twice as fast)
> >
> > I get 0.26s for the OP's puzzle (compared to 0.31s before).
> >
>
> Hmmm, here is one that runs about 10x faster than my original. (Even
> with the declares removed it runs in .07s on my machine.)
Let's not have a pissing contest. Assembly Language beats us all.
The value I see for learning Lisp is to have concise and extremely
expressive (powerful) language that is easy to write and read. OCaml
seems nice, but to this unlearned noobie, the Doctor's code is
beginning to look too much like APL. I also find Wade's bit-vector
optimization less readable than the OP and the 2 immediate condensed
versions.
The value proposition of lisp for me is that it can handle prototyping
all the way to optimization extremely fast and naturally, all the while
remaining quite readable. Python and other languages come close in
different domains; I've yet to find one better than lisp.*
*of course, i'm a noob, maybe i'll see the light of APL next month, who
knows?
Wade Humeniuk
> Wade Humeniuk wrote:
>> Jon Harrop wrote:
>>> Wade Humeniuk wrote:
>>>> Try this faster version... (almost twice as fast)
>>> I get 0.26s for the OP's puzzle (compared to 0.31s before).
>>>
>> Hmmm, here is one that runs about 10x faster than my original. (Even
>> with the declares removed it runs in .07s on my machine.)
>
> Let's not have a pissing contest. Assembly Language beats us all.
>
I certainly agree.
> The value I see for learning Lisp is to have concise and extremely
> expressive (powerful) language that is easy to write and read. OCaml
> seems nice, but to this unlearned noobie, the Doctor's code is
> beginning to look too much like APL. I also find Wade's bit-vector
> optimization less readable than the OP and the 2 immediate condensed
> versions.
>
> The value proposition of lisp for me is that it can handle prototyping
> all the way to optimization extremely fast and naturally, all the while
> remaining quite readable. Python and other languages come close in
> different domains; I've yet to find one better than lisp.*
>
> *of course, i'm a noob, maybe i'll see the light of APL next month, who
> knows?
>
As a final version, here is a clean bit-vector solution that runs fast enough. (.03s)
(declaim (optimize (speed 3) (safety 0) (debug 0)))
(defun make-sudoku-set () (make-array 10 :element-type 'bit :initial-element 0))
(defun digits-in-region (set sudoku x y &aux (xstart (* 3 (floor x 3)))
(ystart (* 3 (floor y 3))))
(loop repeat 3 for x from xstart do
(loop repeat 3 for y from ystart do
(setf (sbit set (aref sudoku y x)) 1))))
(defun digits-in-row (set sudoku y)
(loop for x from 0 below 9 do (setf (sbit set (aref sudoku y x)) 1)))
(defun digits-in-column (set sudoku x)
(loop for y from 0 below 9 do (setf (sbit set (aref sudoku y x)) 1)))
(defun possible-digits (sudoku x y)
(let ((set (make-sudoku-set)))
(digits-in-region set sudoku x y)
(digits-in-row set sudoku y)
(digits-in-column set sudoku x)
set))
(defun solve-next (sudoku x y)
(when (= y 9) (throw 'done sudoku))
(multiple-value-bind (nextx nexty)
(if (< x 8) (values (1+ x) y) (values 0 (1+ y)))
(if (/= 0 (aref sudoku y x))
(solve-next sudoku nextx nexty)
(let ((possible (possible-digits sudoku x y)))
(loop for digit from 1 to 9
when (zerop (sbit possible digit)) do
Pascal Costanza
> Majorinc, Kazimir wrote:
>
>>Lisp users should see your program as a good argument for
>>counting tokens (including parens) instead of lines.
>
> I can justify counting LOC (because you have to sift through code line-by-
> line whilst programming) and bytes (because you have to type code in almost
> byte-by-byte) but tokens don't seem very relevant.
To the contrary: Tokens are more relevant than bytes. An experienced
Lispers uses auto-completion a lot, so it is very rare that you have to
type all the characters of an identifier.
I agree that reducing the number of lines is a good thing. But again,
note that Lisp shows its strengths especially in large programs, where
concepts like closures, macros, generic functions, etc., start to make
sense, not in small toy examples...
Pascal
--
My website: http://p-cos.net
Closer to MOP & ContextL:
http://common-lisp.net/project/closer/
Asbjørn Bjørnstad
> It's rated as the least difficult.
>
> I didn't do as well with the puzzle at
> http://www.ffconsultancy.com/free/sudoku/
>
If you want to test hard puzzles, you can try these:
http://www.csse.uwa.edu.au/~gordon/sudoku17
It's a list of puzzles with only 17 starting positions.
--
-asbjxrn
Wade Humeniuk
the defuns of mark-digit and set-sudoku as noise.
(defun make-sudoku-set () (make-array 10 :element-type 'bit :initial-element 0))
(declaim (inline mark-digit set-sudoku))
(defun mark-digit (set sudoku y x)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type simple-bit-vector set)
(type (simple-array unsigned-byte (9 9)) sudoku)
(type (integer 0 8) y x))
(setf (sbit set (aref sudoku y x)) 1))
(defun set-sudoku (sudoku y x digit)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type (simple-array unsigned-byte (9 9)) sudoku)
(type (integer 0 8) y x)
(type (integer 0 9) digit))
(setf (aref sudoku y x) digit))
(defun digits-in-region (set sudoku x y &aux
(xstart (* 3 (floor x 3)))
(ystart (* 3 (floor y 3))))
(loop repeat 3 for x from xstart do
(loop repeat 3 for y from ystart do
(mark-digit set sudoku y x))))
(defun digits-in-row (set sudoku y)
(loop for x from 0 below 9 do (mark-digit set sudoku y x)))
(defun digits-in-column (set sudoku x)
(loop for y from 0 below 9 do (mark-digit set sudoku y x)))
(defun possible-digits (sudoku x y)
(let ((set (make-sudoku-set)))
(digits-in-region set sudoku x y)
(digits-in-row set sudoku y)
(digits-in-column set sudoku x)
set))
(defun solve-next (sudoku x y)
(when (= y 9) (throw 'done sudoku))
(multiple-value-bind (nextx nexty)
(if (< x 8) (values (1+ x) y) (values 0 (1+ y)))
(if (/= 0 (aref sudoku y x))
(solve-next sudoku nextx nexty)
(let ((possible (possible-digits sudoku x y)))
(loop for digit from 1 to 9
when (zerop (sbit possible digit)) do
(set-sudoku sudoku y x digit)
(solve-next sudoku nextx nexty)
(set-sudoku sudoku y x 0))))))
Asbjørn Bjørnstad
> As another way to optimize the bit-vector solution. Just ignore
> the defuns of mark-digit and set-sudoku as noise.
Isn't this kind of like optimizing bubble sort? If you want a fast
solution, you'll have to change the algorithm. This implementations
strength was simplicity.
Anyway, if you want to go along this route, wouldn't initializing sets
for each row/column/block at the start and update as you go
along be faster as you won't have to recount the sets for each move.
--
-asbjxrn
Frank Buss
> If you want to test hard puzzles, you can try these:
> http://www.csse.uwa.edu.au/~gordon/sudoku17
> It's a list of puzzles with only 17 starting positions.
thanks, they are really hard. I wonder if each of these puzzle have only
one solution. My solver needed 24 minutes for the first puzzle:
(time (solve '(
(0 0 0 0 0 0 0 1 0)
(4 0 0 0 0 0 0 0 0)
(0 2 0 0 0 0 0 0 0)
(0 0 0 0 5 0 4 0 7)
(0 0 8 0 0 0 3 0 0)
(0 0 1 0 9 0 0 0 0)
(3 0 0 4 0 0 2 0 0)
(0 5 0 1 0 0 0 0 0)
(0 0 0 8 0 6 0 0 0))))
Timing the evaluation of (SOLVE (QUOTE ((0 0 0 0 0 0 0 1 0) (4 0 0 0 0 0 0
0 0) (0 2 0 0 0 0 0 0 0) (0 0 0 0 5 0 4 0 7) (0 0 8 0 0 0 3 0 0) (0 0 1 0 9
0 0 0 0) (3 0 0 4 0 0 2 0 0) (0 5 0 1 0 0 0 0 0) (0 0 0 8 0 6 0 0 0))))
693784512
487512936
125963874
932651487
568247391
741398625
319475268
856129743
274836159
user time = 1415.171
system time = 0.375
Elapsed time = 0:24:15
Allocation = 418640 bytes standard / 29230949583 bytes conses
0 Page faults
Calls to %EVAL 34
--
Frank Buss, f...@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
Asbjørn Bjørnstad
> Asbjørn Bjørnstad wrote:
>
> > If you want to test hard puzzles, you can try these:
> > http://www.csse.uwa.edu.au/~gordon/sudoku17
> > It's a list of puzzles with only 17 starting positions.
>
> thanks, they are really hard. I wonder if each of these puzzle have only
> one solution. My solver needed 24 minutes for the first puzzle:
Yes, they do. That is part of the requirements for a puzzle. There should
only be one solution. When I wrote my solver a month or so ago, no
puzzles with less than 17 hints were known. So these puzzles are about
as hard as they get when it comes to search space.
--
-asbjxrn
Dr. John A.R. Williams
I wrote a Sudoku solver in Lisp some months ago. If you naively simply
search every tree then there are a lot of solutions to consider and it
will take a long time. By adding the capability to add heiristics to
trim the tree early, and after adding in just one obvious heiristic
the solve time for the hardest problem I could find was about 6ms
average, using compiled code in CMUCL.
>>>>> "Frank" == Frank Buss <f...@frank-buss.de> writes:
Frank> Asbjørn Bjørnstad wrote:
>> If you want to test hard puzzles, you can try these:
>> http://www.csse.uwa.edu.au/~gordon/sudoku17 It's a list of
>> puzzles with only 17 starting positions.
Frank> thanks, they are really hard. I wonder if each of these
Frank> puzzle have only one solution. My solver needed 24 minutes
Frank> for the first puzzle:
Frank> (time (solve '( (0 0 0 0 0 0 0 1 0) (4 0 0 0 0 0 0 0 0) (0
Frank> 2 0 0 0 0 0 0 0) (0 0 0 0 5 0 4 0 7) (0 0 8 0 0 0 3 0 0) (0
Frank> 0 1 0 9 0 0 0 0) (3 0 0 4 0 0 2 0 0) (0 5 0 1 0 0 0 0 0) (0
Frank> 0 0 8 0 6 0 0 0)))) Timing the evaluation of (SOLVE (QUOTE
Frank> ((0 0 0 0 0 0 0 1 0) (4 0 0 0 0 0 0 0 0) (0 2 0 0 0 0 0 0
Frank> 0) (0 0 0 0 5 0 4 0 7) (0 0 8 0 0 0 3 0 0) (0 0 1 0 9 0 0 0
Frank> 0) (3 0 0 4 0 0 2 0 0) (0 5 0 1 0 0 0 0 0) (0 0 0 8 0 6 0 0
Frank> 0)))) 693784512 487512936 125963874 932651487 568247391
Frank> 741398625 319475268 856129743 274836159
Frank> user time = 1415.171 system time = 0.375 Elapsed time =
Frank> 0:24:15 Allocation = 418640 bytes standard / 29230949583
Frank> bytes conses 0 Page faults Calls to %EVAL 34
Frank> -- Frank Buss, f...@frank-buss.de http://www.frank-buss.de,
Frank> http://www.it4-systems.de
--
Dr. John A.R. Williams
Electronic Engineering, Aston University, Birmingham B4 7ET
Tel: 0121 359 3621 x 4989 Fax: 0121 359 0156
www: http://www.ee.aston.ac.uk/staff/willijar
PGP key: 6606795A185C384C
Patrick May
> Asbjørn Bjørnstad wrote:
> > If you want to test hard puzzles, you can try these:
> > http://www.csse.uwa.edu.au/~gordon/sudoku17 It's a list of puzzles
> > with only 17 starting positions.
>
> thanks, they are really hard. I wonder if each of these puzzle have
> only one solution. My solver needed 24 minutes for the first puzzle:
That's interesting. My rule-based solver only needed the
constraints of keeping the possible values set correctly and setting
cells with a single possibility to that value plus the repeated
application of the rule identifying single possibilities in a row,
column, or grid.
On the other hand, I need to add the X-Wing and Swordfish rules
to be able to solve some of the puzzles yours finishes quickly.
Regards,
Patrick
------------------------------------------------------------------------
S P Engineering, Inc. | The experts in large scale distributed OO
| systems design and implementation.
p...@spe.com | (C++, Java, Common Lisp, Jini, CORBA, UML)
Jon Harrop
> Isn't this kind of like optimizing bubble sort? If you want a fast
> solution, you'll have to change the algorithm. This implementations
> strength was simplicity.
Yes. Perhaps it would be interesting to plot verbosity vs performance for
different algorithms in different languages?
I updated the ray tracer page with byte counts as well as LOC, BTW:
http://www.ffconsultancy.com/free/ray_tracer/languages.html
Something similar for Sudoku solvers might be interesting. I have versions
in several languages now...
Alexander Schmolck
> Alexander Schmolck wrote:
> > Jon Harrop <use...@jdh30.plus.com> writes:
> >> This illustrates the irrelevancy of tokens from the point of view of the
> >> programmer - we don't know or care what constitutes a token.
> >
> > Only if the language doesn't support syntactic abstraction.
>
> Both Lisp and OCaml support syntactic abstraction but token counts seem much
> more applicable to Lisp than they do to OCaml.
How does syntactic abstraction with caml4p work, if it doesn't require you to
know what the tokens in the language are?
'as
Jon Harrop
> How does syntactic abstraction with caml4p work, if it doesn't require you
> to know what the tokens in the language are?
You only need to know the relevant tokens, not all ~96 of them.
ana...@earthlink.net
> ana...@earthlink.net wrote:
> > Jon Harrop wrote:
> >> An obvious problem is the definition of a token.
> >
> > Nope - token defined by the language...
>
> Then you're advocating that I root through the OCaml compiler's lexer to
> find out how it happens to interpret characters as tokens.
Only if OCaml's token definition is context-specific and/or complex in
an unnatural way. If that's true, I hope that there's some
corresponding
benefit.
BTW - The "precedence works and is natural" assertion implies that
context-specific and/or complex token definitions aren't a problem.
> That implies to me that tokens aren't very relevant to the programmer.
Actually, it implies that certain languages require folks to work at
sub-token
level, to puzzle things out.
Perhaps that complex grammar stuff isn't quite as valuable as has been
asserted.
Dr Jon D Harrop
> Jon Harrop wrote:
> > Then you're advocating that I root through the OCaml compiler's lexer to
> > find out how it happens to interpret characters as tokens.
>
> Only if OCaml's token definition is context-specific and/or complex in
> an unnatural way.
No, the complexity of the tokens and how "natural" they are is
irrelevant. The only way to find out what constitutes a token in OCaml
is to read the compiler's source code.
> BTW - The "precedence works and is natural" assertion implies that
> context-specific and/or complex token definitions aren't a problem.
How did you draw that conclusion? Precedence is a feature of the
grammar and is basically unrelated to the definition of a token.
> > That implies to me that tokens aren't very relevant to the programmer.
>
> Actually, it implies that certain languages require folks to work at
> sub-token level, to puzzle things out.
It implies that certain languages require folks to work at not-token
level. Hence my saying that token count is irrelevant.
> Perhaps that complex grammar stuff isn't quite as valuable as has been
> asserted.
That statement is too vague to be useful. If the grammar is too simple
(e.g. Whitespace) then the language will not be expressive enough. If
the grammar is too complex then the language will be too difficult to
learn. So there is some happy medium where language complexity is
optimal. I'd say that anything between Scheme/Lisp and ML/Haskell is
close enough to the optimum that other features are more important.
Cheers,
Jon.
Wade Humeniuk
> Wade Humeniuk <whumeniu+...@telus.net> writes:
>
>> As another way to optimize the bit-vector solution. Just ignore
>> the defuns of mark-digit and set-sudoku as noise.
>
> Isn't this kind of like optimizing bubble sort? If you want a fast
> solution, you'll have to change the algorithm. This implementations
> strength was simplicity.
>
Isn't it 10x faster? Or did I miss something? Anyways, got a better
(in this case smarter and faster) algorithm??
Wade
Asbjørn Bjørnstad
> Asbjørn Bjørnstad wrote:
> > Wade Humeniuk <whumeniu+...@telus.net> writes:
> >
> >> As another way to optimize the bit-vector solution. Just ignore
> >> the defuns of mark-digit and set-sudoku as noise.
> > Isn't this kind of like optimizing bubble sort? If you want a fast
> > solution, you'll have to change the algorithm. This implementations
> > strength was simplicity.
>
> Isn't it 10x faster? Or did I miss something? Anyways, got a better
> (in this case smarter and faster) algorithm??
Sorry if I was too dismissive, I didn't run any of the algorithms so I
didn't know what kind of speedup you got. But as far as I could tell
the basic algorithm was still a ordinary depth first search.
A common fast algorithm to use for sudoku is Donald Knuths dancing links.
I used it in my solver (http://www.jalat.com/blogs/lisp?id=4), but as
PeatyK mentioned it's not as simple to understand and at least my
implementation is a lot longer than the ones listed here.
--
-asbjxrn
Pea...@gmail.com
competition is titled sudoku...
http://www.topcoder.com/longcontest/?module=ViewActiveContests&rt=15
GP lisper
>
> On the other hand, I need to add the X-Wing and Swordfish rules
> to be able to solve some of the puzzles yours finishes quickly.
That is the essence of the puzzles attraction; the tug of war between
the two methods, which will win in the next puzzle?? Is there an uber
method?
--
Fairy tales do not tell children the dragons exist.
Children already know that dragons exist.
Fairy tales tell children the dragons can be killed. -- G.K.Chesterton
*** Free account sponsored by SecureIX.com ***
*** Encrypt your Internet usage with a free VPN account from http://www.SecureIX.com ***
ana...@earthlink.net
> ana...@earthlink.net wrote:
> > Only if OCaml's token definition is context-specific and/or complex in
> > an unnatural way.
>
> No, the complexity of the tokens and how "natural" they are is
> irrelevant. The only way to find out what constitutes a token in OCaml
> is to read the compiler's source code.
It's quite relevant. We've seen the claim that certain characteristics
and languages are more better than others because they build on
prior experience or are easy to understand.
It's pretty safe to say that an OCaml compiler's source is rarely
prior experience. Since Harrop didn't know, we can safely ignore
any "easy to understand" that he might make.
> > BTW - The "precedence works and is natural" assertion implies that
> > context-specific and/or complex token definitions aren't a problem.
>
> How did you draw that conclusion? Precedence is a feature of the
> grammar and is basically unrelated to the definition of a token.
Token definition is part of the grammar. As an efficiency hack, we
often
treat it separately, but that's an optimization. (Insert C++ jab
concerning
">>" and templates.)
> > Actually, it implies that certain languages require folks to work at
> > sub-token level, to puzzle things out.
>
> It implies that certain languages require folks to work at not-token
> level. Hence my saying that token count is irrelevant.
Since those languages also have tokens and one has to also work with
them, required subtoken work is another cost that must be counted
for those languages. Unless that reduces their costs at the token
level
or above, that's a net loss.
> > Perhaps that complex grammar stuff isn't quite as valuable as has been
> > asserted.
>
> That statement is too vague to be useful. If the grammar is too simple
> (e.g. Whitespace) then the language will not be expressive enough.
Nope . Whitespace as token separator is quite sufficient and
expressive
and very easy to understand ,at least for folks who know English and
most
"western" written languages.Yes ,we do drop the space before terminal
punctuation andafterinitialpunctuation,but
that'sprettymuchasfarasitgoes.
(I violated those rules to demonstrate that.)
I realize that some folks think that the ability to omit spaces around
characters
such as + is a big deal, but they're forced to use abominations like
xp1
instead of the more natural x+1 for a variable whose value is a bit
more than x.
-andy
Joerg Hoehle
> Nice, clean, concise, but so mechanical. My version solves it
> like a human would, although it takes a few (hundred) more lines:
I liked this approach over the "brute force iterate through squares".
I liked it even more because it allows a classification of Sudoku
grids according to the rules needed.
Your rules are loosely related to a notion of "depth". You could
integrate all your rules into one solver by programming a variation on
the "iterative widening" algorithm: if it fails using simple rules,
add more and repeat. Then print the required "depth" or classification.
> http://www.spe.com/pjm/sudoku.lisp
BTW, you missed an excellent opportunity for using REDUCE:
Instead of:
(set-difference (possible-values cell)
(remove-duplicates
(mappend #'possible-values
other-unknown-cells)))
use:
(reduce #'set-difference other-unknown-cells
:key #'possible-values
:initial-value (possible-values cell))
as in:
(defun single-possibility-in-list (cells)
"If there is only one cell in the list CELLS that can possibly hold a
particular value, set it appropriately."
(dolist (cell cells)
(unless (value cell)
(let* ((other-unknown-cells (remove cell (remove-if #'value cells)))
(unique-values
(reduce #'set-difference other-unknown-cells
:key #'possible-values
:initial-value (possible-values cell))))
(when (= 1 (length unique-values))
(set-value cell (car unique-values)))))))
which one is faster may depend on the implementation.
BTW, your approach is still somewhat "brute force" since you still
perform "do for all rows, columns and boxes". You don't do a full
constraint propagation, like in "I changed this cell, which other ones
depend on it?" Did anybody use full constraint propagation?
Kenny with cells? :-)
Regards,
Jorg Hohle
Telekom/T-Systems Technology Center
Julian Stecklina
My solver solves the first one in 1,7 ms on my 1,4 GHz
Pentium-M. Seems ok for my first Sudoku solver. :) Has anyone an
implementation of the "Algorithm X" (Dancing links)? I would be
interested on how well it does on these puzzles.
Regards,
--
Julian Stecklina
"I object to doing things that computers can do." - Olin Shivers
Bob Felts
> F...@while.it.lasted.invalid (Asbjørn Bjørnstad) writes:
>
> > wr...@stablecross.com (Bob Felts) writes:
> >
> >> It's rated as the least difficult.
> >>
> >> I didn't do as well with the puzzle at
> >> http://www.ffconsultancy.com/free/sudoku/
> >>
> >
> > If you want to test hard puzzles, you can try these:
> > http://www.csse.uwa.edu.au/~gordon/sudoku17
> > It's a list of puzzles with only 17 starting positions.
>
> My solver solves the first one in 1,7 ms on my 1,4 GHz
> Pentium-M. Seems ok for my first Sudoku solver. :) Has anyone an
> implementation of the "Algorithm X" (Dancing links)? I would be
> interested on how well it does on these puzzles.
>
http://www.jalat.com/blogs/lisp?id=4
I haven't tried running it.
Wade Humeniuk
> A common fast algorithm to use for sudoku is Donald Knuths dancing links.
> I used it in my solver (http://www.jalat.com/blogs/lisp?id=4), but as
> PeatyK mentioned it's not as simple to understand and at least my
> implementation is a lot longer than the ones listed here.
Thank you very very much for the link. I also now have Knuth's Dancing Colors
paper. I have had some time to sit down and really look at them. The
whole technique seems very useful.
Wade
Patrick May
> I liked it even more because it allows a classification of Sudoku
> grids according to the rules needed.
>
> Your rules are loosely related to a notion of "depth". You could
> integrate all your rules into one solver by programming a variation
> on the "iterative widening" algorithm: if it fails using simple
> rules, add more and repeat. Then print the required "depth" or
> classification.
That's roughly what I'm modifying it to do now. Many of the
puzzles graded as "Fiendish" by the newspapers are solvable with just
the simplest rules.
> > http://www.spe.com/pjm/sudoku.lisp
>
> BTW, you missed an excellent opportunity for using REDUCE:
Thanks for that. I don't often get the opportunity to work with
other people who use Lisp, so this kind of feedback is very helpful.
> Did anybody use full constraint propagation? Kenny with cells? :-)
Thank goddess you asked. I thought this might be the first
comp.lang.lisp thread in three years that didn't mention Cells. ;-)
Joerg Hoehle
> (declaim (inline mark-digit set-sudoku))
> (defun mark-digit (set sudoku y x)
> (declare (optimize (speed 3) (safety 0) (debug 0))
> (type simple-bit-vector set)
> (type (simple-array unsigned-byte (9 9)) sudoku)
> (type (integer 0 8) y x))
>
> (defun set-sudoku (sudoku y x digit)
> (defun digits-in-region (set sudoku x y &aux
I wonder why everybody insists on having lots of top-level definitions.
From what I remember about CMUCL, it has a concept of block compilation.
As a result,
1) functions part of and limited to a block can be jumped to faster
than other ones (where you need to go through fdefinition or some such).
2) many declarations can be omitted when the compilers knows the
single (or few) caller of a function: it can infer types.
You could keep your code clean.
A portable way is to use nested functions (as in Pascal).
Why do I see so little use of them?
Does Henry Bakers argument about editing comfort apply (cf. "critique of
DIN Kernel Lisp")?
FLET and LABELS should allow you to produce slightly faster code than
accessing top-level functions.
Asbjørn Bjørnstad
It's not as fast. At least not for a single puzzle as there is a lot
of work setting up the ~1000 doble-linked lists before you can start
solving the puzzle. For a single puzzle the cost may be too high, that
structure can be reused though. But for a real test I'd try 16x16
sudoku or something.
1.7 ms is very good. I think I used about 1.4 ms just writing out each
solution :-)
--
-asbjxrn
Peter Seibel
I'm sometimes tempted to use lots of FLETs and LABELs both for the
potential efficiency gains you mention and also (probably more
important) to provide a bit of encapsulation/modularity/whatever you
want to call it. The problem with that is that is then you can't test
the individual nested functions easily. (I.e. the encapsulation is
working, only against you.)
-Peter
--
Peter Seibel * pe...@gigamonkeys.com
Gigamonkeys Consulting * http://www.gigamonkeys.com/
Practical Common Lisp * http://www.gigamonkeys.com/book/
Julian Stecklina
>> http://www.jalat.com/blogs/lisp?id=4
>>
>> I haven't tried running it.
>
> It's not as fast. At least not for a single puzzle as there is a lot
> of work setting up the ~1000 doble-linked lists before you can start
> solving the puzzle. For a single puzzle the cost may be too high, that
> structure can be reused though. But for a real test I'd try 16x16
> sudoku or something.
My algorithm gets noticeably slower on difficult 16x16 sudokus, and I
think Knuth's algorithm would be faster, even though it needs huge
datastructures. I'll implement my own version and do some timing if I
have a day spare.
Joerg Hoehle
> Thanks for that. I don't often get the opportunity to work with
> other people who use Lisp, so this kind of feedback is very helpful.
On the top of my head:
o you use several MAPCAR MAPLIST where you throw the result away.
Use MAPC and MAPL instead.
The compiler cannot always do this optimization for you (e.g. in your
case, it's the result of a defmethod, so it cannot).
o you use (if (> (length foo) some-value))
Instead, consider using
(if (cdr foo) ...)
(if (nthcdr some-value foo) ...
There's no need to waste time going through the whole list.
Consider implementing a list-length< abstraction.
BTW, did you implement x-wing, swordfish and whatever else? My wife
showed me a puzzle where all-rules is not enough (and she's not solved
yet either). Wade Humeniuk's brute-force algorithm solved it.
Joerg Hoehle
> Joerg Hoehle <hoe...@users.sourceforge.net> writes:
> > see so little use of them? Does Henry Bakers argument about editing
> > comfort apply (cf. "critique of DIN Kernel Lisp")?
> The problem with that is that is then you can't test
> the individual nested functions easily. (I.e. the encapsulation is
> working, only against you.)
That's exactly one of H.Baker's critiques: lack of decent editor
support to move such things around easily: e.g. turn an flet into a
defun and vice-versa.
Maybe paredit.el which I haven't yet tried out does this?
BTW, one of our former students with a Pascal background wrote a lot
of code with LABELS and FLET.
I found his code very readable.
Giving names to anonymous functions helps self-documentation.
Patrick May
> BTW, did you implement x-wing, swordfish and whatever else? My wife
> showed me a puzzle where all-rules is not enough (and she's not
> solved yet either). Wade Humeniuk's brute-force algorithm solved
> it.
At the risk of great public embarrassment, here's my current
working version of X-Wing in a row:
(defclass locked-pair ()
((pair :initarg :pair
:accessor pair
:initform nil)
(value :initarg :value
:accessor value
:initform nil))
(:documentation "A pair of cells locked with respect to the same value."))
(defun locked-pairs (cells)
"Return a list of the locked pairs in the specified list of cells."
(let ((unknown-cells (remove-if #'value cells))
(locked-pairs nil))
(dolist (cell unknown-cells locked-pairs)
(dolist (value (possible-values cell))
(let ((possible-pairs
(remove-if-not (lambda (cell)
(member value (possible-values cell)))
(remove cell unknown-cells))))
(when (and (= 1 (length possible-pairs))
(not (member value (mapcar #'value locked-pairs))))
(push (make-instance 'locked-pair
:pair (cons cell possible-pairs)
:value value)
locked-pairs)))))))
(defmethod x-wing-row-rule ((grid sudoku-grid))
"When two rows each have a possible value in exactly two cells and
those cells are in the same columns, that value can be eliminated as a
possibility in all other cells of those two columns. This is because
the value must be in one or the other pair of diagonally opposite
cells. The name of the rule comes from the X connecting those pairs."
(labels ((locked-columns (locked-pair)
(mapcar #'grid-column (pair locked-pair))))
(with-each-row grid row
(dolist (locked-pair (locked-pairs row))
(dolist (other-row (remove row (rows grid)))
(unless (= (grid-row (car row)) (grid-row (car other-row)))
(let ((match
(find-if
(lambda (other-pair)
(and (= (value locked-pair) (value other-pair))
(= 2 (length (intersection
(locked-columns locked-pair)
(locked-columns other-pair))))))
(locked-pairs other-row))))
(when match
(let ((column-cells
(append
(column grid (grid-column (first (pair match))))
(column grid (grid-column (second (pair match))))))
(locked-cells (append (pair match) (pair locked-pair))))
(mapcar (lambda (cell)
(remove-possibility cell (value locked-pair)))
(set-difference column-cells locked-cells)))))))))))
This is the first thing I typed in that worked. I'm going to break it
down into a function for identifying X-Wings and another that uses
that and reduces the possible values, but real life work is getting in
the way of my random hacking.
Holger Schauer
> I wonder why everybody insists on having lots of top-level
> definitions.
Well, I'm certainly not everybody but ...
> A portable way is to use nested functions (as in Pascal).
> Why do I see so little use of them?
> FLET and LABELS should allow you to produce slightly faster code than
> accessing top-level functions.
I would see that as an optimization. I've been bitten times and times
again from hard to track down errors that hid themselves in such
embedded functions (labels, mainly). So I've come to the conclusion
that I only hide such functions (helpers, typically) if I really want
to de-uglify the API of the code at hand and only at a stage where I'm
certain it's bug free. More often than not, I don't bother with it
(when it comes to aesthetics, Jackson's famous quote probably seems
even more appropriate).
Holger
--
--- http://www.coling.uni-freiburg.de/~schauer/ ---
Fachbegriffe der Informatik - Einfach erklärt
73: Datenautobahn
Einrichtung zur schnellen Übertragung großer Datenmengen (z.B.
über das Telefonnetz) (DUDEN, 21. Auflage)
Alexander Schmolck
> > A portable way is to use nested functions (as in Pascal). Why do I
> > see so little use of them? Does Henry Bakers argument about editing
> > comfort apply (cf. "critique of DIN Kernel Lisp")? FLET and LABELS
> > should allow you to produce slightly faster code than accessing
> > top-level functions.
>
> I'm sometimes tempted to use lots of FLETs and LABELs both for the
> potential efficiency gains you mention and also (probably more
> important) to provide a bit of encapsulation/modularity/whatever you
> want to call it. The problem with that is that is then you can't test
> the individual nested functions easily. (I.e. the encapsulation is
> working, only against you.)
How about shadowing DEFUN with a custom version that behaves similarly to
scheme's DEFINE, i.e. that translates further DEFUNs at the beginning of its
body into a LABELS form?
'as
Joerg Hoehle
> Peter Seibel <pe...@gigamonkeys.com> writes:
> > I'm sometimes tempted to use lots of FLETs and LABELs both for the
> > potential efficiency gains you mention and also (probably more
> > important) to provide a bit of encapsulation/modularity/whatever you
> > want to call it. The problem with that is that is then you can't test
> > the individual nested functions easily. (I.e. the encapsulation is
> > working, only against you.)
>
> How about shadowing DEFUN with a custom version that behaves similarly to
> scheme's DEFINE, i.e. that translates further DEFUNs at the beginning of its
> body into a LABELS form?
Indeed, my little Scheme (BRL/Kawa) experience had it that I
appreciated DEFINE for being able to move it around between top-level
and inner bodies.
What's missing is a function (in Emacs) that says "hey, don't move
this one, it closes over the variable xyz".
Jens Axel Søgaard
> Indeed, my little Scheme (BRL/Kawa) experience had it that I
> appreciated DEFINE for being able to move it around between top-level
> and inner bodies.
Beware that the semantics of inter defines and defines at the
top-level are different.
Which by the way is the reason the LOCAL contruct was introduced
in PLT Scheme.
See
<http://groups.google.com/group/comp.lang.scheme/browse_frm/thread/855f04f9ffaf8753/cb2b66b0e46e02be>
--
Jens Axel Søgaard
Alexander Schmolck
I've only skimmed this, so correct me if I'm wrong, but
a) isn't scheme's inner define behaviour simply braindamaged (i.e. there would
be no need for the local kludge if the standard weren't broken)?
b) expanding into labels ought to behave like the desired (local (define
...)), no?
'as
Joerg Hoehle
> At the risk of great public embarrassment, here's my current
> working version of X-Wing in a row:
> (dolist (other-row (remove row (rows grid)))
Maybe you changed the class definition of a grid since I downloaded
your code, but with what I have from your site, namely
(defclass sudoku-grid ()
((cells :initarg :cells
:accessor grid-cells
:initform (make-array (list +grid-rows+ +grid-columns+)
:initial-element nil))
...,
there's no easy definition for the function rows (as in (rows grid))
above such that (REMOVE row (rows grid)) would do what you expect it
to do -- you'd need to memoize or some such to preserve equality.
(you've not shown your definition of rows, so I can't test your code).
(and defmethod row conses up a new list upon each invocation)
Jens Axel Søgaard
> a) isn't scheme's inner define behaviour simply braindamaged (i.e. there would
> be no need for the local kludge if the standard weren't broken)?
According to
<http://www.schemers.org/Documents/Standards/Charter/mar-2005.txt>
in R6RS internal defines will be defined in terms of letrec*
in stead of letrec.
--
Jens Axel Søgaard
Patrick May
> Maybe you changed the class definition of a grid since I downloaded
> your code, but with what I have from your site, namely
I updated the whole file: http://www.spe.com/pjm/sudoku.lisp
Enjoy,
Ralph Richard Cook
package of Screamer. It's described at
http://i-need-closures.blogspot.com/2006/03/lets-scream.html
Bernd Schmitt
Thanks,
Bernd
--
T_a_k_e__c_a_r_e__o_f__y_o_u_r__R_I_G_H_T_S.
P_r_e_v_e_n_t__L_O_G_I_C--P_A_T_E_N_T_S
http://www.ffii.org, http://www.nosoftwarepatents.org
Marc Battyani
"Bernd Schmitt" <Bernd.Sch...@gmx.net> wrote
> On 03.03.2006 04:07, Ralph Richard Cook wrote:
>> I have a version to throw into the pile; It uses the constraint
>> package of Screamer. It's described at
>> http://i-need-closures.blogspot.com/2006/03/lets-scream.html
> what is screamer (it was not listed on the linked wiki-page)?
http://www.cl-user.net/asp/libs/screamer
Marc
Pascal Bourguignon
From: "EurekAlert! - Breaking News"
Subject: From biological imaging to Sudoku solutions
Veit Elser, Cornell professor of physics, has found that an algorithm
developed to process X-ray diffraction data also solves Sudoku
puzzles.
URL: http://www.eurekalert.org/pub_releases/2006-03/cuns-fbi030306.php
--
__Pascal Bourguignon__ http://www.informatimago.com/
In a World without Walls and Fences,
who needs Windows and Gates?
Jimka
(loop for i from 1 to 9
with result = '()
finally (return result) do
(unless (find i list) (push i result))))
Can this implementation be replaced by a simple
call to set-difference? Or is it doing something
else clever that i cannot see?
(defun create-missing (list)
(set-difference '(1 2 3 4 5 6 7 8 9) list))
Jimka
else already suggested it.
Jimka
different algorithm for the sudoku solution.
rather than iterating over the 9x9 from left-to-right
top-to-bottom, each time i sort the remaining unsolved cells
and consider the remaining one which has the least number of
possible solutions.
It is a bit suprising to me that even with this additional overhead of
copying and sorting, the total search time seems less. perhaps
it is because sbcl has a good garbage collector.
i'm interested as to whether anyone else sees similar results.
(defun print-sudoku (sudoku)
(loop for y from 0 below 9
finally (terpri)
do (loop for x from 0 below 9 finally (terpri) do
(format t "~A" (aref sudoku y x)))) )
(defvar *unsolved* '-)
(defun unsolved (x)
(eql x *unsolved*))
(defun solved (x)
(not (unsolved x)))
(defun digits-in-region (sudoku x y)
(loop
with x0 = (* 3 (truncate x 3))
with y0 = (* 3 (truncate y 3))
with x1 = (+ x0 2)
with y1 = (+ y0 2)
for x from x0 to x1
append (loop for y from y0 to y1
for digit = (aref sudoku y x)
when (solved digit) collect digit)))
(defun digits-in-row (sudoku y)
(loop for x from 0 below 9
for digit = (aref sudoku y x)
when (solved digit) collect digit))
(defun digits-in-column (sudoku x)
(loop for y from 0 below 9
for digit = (aref sudoku y x)
when (solved digit) collect digit))
(defun possible-digits (sudoku x y)
(set-difference
'(1 2 3 4 5 6 7 8 9)
(nconc (digits-in-region sudoku x y)
(digits-in-row sudoku y)
(digits-in-column sudoku x))))
;; return a list of conses, each signifies an x,y
;; a yet unsolved cell in the sudoku array sorted by how
;; many possible digits the cell has.
;; The least number of possibities first.
(defun sort-cells (sudoku )
(sort-cells-pairs sudoku
(loop for x from 0 below 9
nconc (loop for y from 0 below 9
when (unsolved (aref sudoku y x))
collect (cons x y)))))
(defun sort-cells-pairs (sudoku pairs)
(when pairs
(sort (copy-list pairs)
#'<
:key (lambda (pair)
(length (possible-digits sudoku (car pair) (cdr pair)))))))
(defun print-cells (sudoku pairs)
(when pairs
(format t "~A,~A: ~A~%" (car (car pairs))
(cdr (car pairs))
(possible-digits sudoku (car (car pairs))
(cdr (car pairs))))
(print-cells sudoku (cdr pairs))))
(defun solve (sudoku)
(labels ((solve-next
(pairs)
(unless pairs
(print-sudoku sudoku)
(return-from solve))
(let ((pair (car pairs)))
(let ((x (car pair))
(y (cdr pair)))
(pop pairs)
(let ((possible-digits (possible-digits sudoku x y)))
(when possible-digits
(dolist (digit possible-digits)
(setf (aref sudoku y x) digit)
(setf pairs (sort-cells-pairs sudoku pairs))
(solve-next pairs))
(setf (aref sudoku y x) *unsolved*)))))))
(solve-next (sort-cells sudoku))))
(defparameter *sudoku-1* (make-array '(9 9) :initial-contents
'((- - 2 3 - - 7 - -)
(- - 4 - - 9 - - -)
(6 - - - - - - 5 -)
(- 7 - - - 2 - 6 -)
(- - 3 7 - - 4 - -)
(- 1 - - - - - 2 -)
(- 3 - - - - - - 9)
(- - - 4 - - 6 - -)
(- - 5 - - 8 2 - -))))
(time (solve *sudoku-1*) )
Jimka
speed in some cases. too bad every case is not best case :-(
Thanks to Pascal Bourguignon and Frank Buss
for helping speed up the remove-preserving-tail
function.
(defvar *unsolved* '-)
(defun unsolved (x)
(eql x *unsolved*))
(defun solved (x)
(numberp x))
(defun print-sudoku (sudoku)
(loop for y from 0 below 9
finally (terpri)
do (loop for x from 0 below 9 finally (terpri) do
(format t "~A" (if (plusp (aref sudoku y x))
(aref sudoku y x)
*unsolved*)))))
(defun digits-in-region (sudoku x y)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type simple-array sudoku)
(type (integer 0 8) x y))
(loop
with x0 = (* 3 (truncate x 3))
with y0 = (* 3 (truncate y 3))
with x1 = (+ x0 2)
with y1 = (+ y0 2)
for x from x0 to x1
append (loop for y from y0 to y1
for digit = (aref sudoku y x)
when (solved digit) collect digit)))
(defun digits-in-row (sudoku y)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type (simple-array sudoku))
(type (integer 0 8) y))
(loop for x from 0 below 9
for digit = (aref sudoku y x)
when (solved digit) collect digit))
(defun digits-in-column (sudoku x)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type (simple-array sudoku))
(type (integer 0 8) x))
(loop for y from 0 below 9
for digit = (aref sudoku y x)
when (solved digit) collect digit))
(defun possible-digits (sudoku x y)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type (simple-array sudoku))
(type (integer 0 8) x y))
(set-difference
'(1 2 3 4 5 6 7 8 9)
(nconc (digits-in-region sudoku x y)
(digits-in-row sudoku y)
(digits-in-column sudoku x))))
(defun print-cells (sudoku pairs)
(when pairs
(format t "~A,~A: ~A~%" (car (car pairs))
(cdr (car pairs))
(possible-digits sudoku (car (car pairs))
(cdr (car pairs))))
(print-cells sudoku (cdr pairs))))
(defun solve (sudoku)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type simple-array sudoku)
(type (simple-array unsigned-byte (9 9)) sudoku))
(labels ((sort-cells (pairs)
;; caculate a list similar to the given list of pairs
;; except that an element which minimizes
;; #'possible-digits is moved to the beginning of
;; the list.
(min-and-rest pairs
:key
(lambda (pair)
(length (the list (possible-digits
sudoku
(car pair)
(cdr pair)))))))
(solve-next (pairs)
(unless pairs
(print-sudoku sudoku)
(return-from solve))
(let ((pair (car pairs))
(pairs (cdr pairs)))
(let ((x (car pair))
(y (cdr pair)))
(let ((possible-digits
(possible-digits sudoku x y)))
;; if there are no possible digits,
;; then backtrack
(when possible-digits
;; try each possible solution for this
;; position until one works or we have to
;; backtrack.
(dolist (digit possible-digits)
(setf (aref sudoku y x) digit)
;; move the remaining unsolved cell which has
;; the minimum number of possible digits to
;; the beginning of the list of remaining
;; cells, and solve away.
(solve-next (sort-cells pairs)))
;; return the cell to unsolved,
;; and backtrack.
(setf (aref sudoku y x) *unsolved*)))))))
;; call solve-next with list of all unsolved cells
;; sorted into in order of increasing possible digits.
;; Note, this sorting only occures once at the top level,
;; thereafter it is hoped that the list is almost sorted.
;; By almost sorted, i mean that every element is not too far
;; from the ideal sorted position.
(solve-next (sort (loop for x from 0 below 9
nconc (loop for y from 0 below 9
when (unsolved (aref sudoku y x))
collect (cons x y)))
#'<
:key (lambda (pair)
(length (possible-digits sudoku
(car pair)
(cdr pair))))))))
;; if the first element of the given list minimizes the key function,
;; then return the list,
;; else build a new list with the minimizing element first
;; followed by the rest of the list. If the minimizing element
;; appears more the once, the first occuranc will simply be moved
;; to the beginning of the new list.
;; E.g.,
;; ( 3 4 5 6 0 6 7 0 2 3)
;; ---> ( 0 3 4 5 6 6 7 0 2 3)
(defun min-and-rest (list &key (key #'identity) (test #'<))
(loop with min = (car list)
for elem in list
;; when test < min
when (funcall test (funcall key elem) (funcall key min))
do (setq min elem)
finally (return (if (eql min (car list))
list
(cons min (remove-preserving-tail min list))))))
;; remove an element from a list the first time the element
;; occurs and only consing the minimum amount of cells
;; possible.
;; If the item is not found in the list, then return the list.
;; else return a copy of the first portion of the list and
;; share the remaining tail after the skipped item.
(defun remove-preserving-tail (item list)
(labels ((rpt (sub)
(cond ((null sub)
(return-from remove-preserving-tail list))
((eql item (car sub))
(cdr sub))
(t
(cons (car sub) (rpt (cdr sub)))))))
(rpt list)))
;; unused testing function
(defun exhaust-list (done list)
(when list
(format t "~A~%" (list done list))
(dolist (item list)
(exhaust-list (cons item done) (remove-preserving-tail item
list)))))
(defun make-sudoku (list)
(make-array '(9 9)
:adjustable nil
:initial-contents
list))
(defparameter *sudoku-1* (make-sudoku
'((- - 2 3 - - 7 - -)
(- - 4 - - 9 - - -)
(6 - - - - - - 5 -)
(- 7 - - - 2 - 6 -)
(- - 3 7 - - 4 - -)
(- 1 - - - - - 2 -)
(- 3 - - - - - - 9)
(- - - 4 - - 6 - -)
(- - 5 - - 8 2 - -))))
(defparameter *sudoku-2* (make-sudoku
'(( - - 9 1 8 3 - - 4)
( - - - - - 5 8 2 9)
( 4 8 6 - - - - - -)
( 8 - - - 5 - 3 9 -)
( - 6 - 8 4 9 - 1 -)
( - 9 7 - 2 - - - 8)
( - - - - - - 4 6 7)
( 5 2 1 6 - - - - -)
( 6 - - 9 3 8 2 - -))))
(time (solve *sudoku-1*) )
(time (solve *sudoku-2*) )
mad...@iitgn.ac.in
On Tuesday, February 21, 2006 at 3:14:04 AM UTC+5:30, Frank Buss wrote:
> Just a minor cleanup of the code I wrote some months ago, because I wrote a
> letter to the editor of the german issue of Scientific American, because
> the author of an article about Sudoku wrote, that it is possible to write a
> solver in a few hundred lines of Prolog, so I thought it is a good idea to
> write it in 50 lines of Common Lisp :-)
>
> http://www.frank-buss.de/lisp/sudoku.html
>
> --
> Frank Buss, f...@frank-buss.de
> http://www.frank-buss.de, http://www.it4-systems.de