tag:blogger.com,1999:blog-5048733824376310579.post-33863715252433247012007-06-28T22:19:00.001-05:002007-07-06T13:03:01.891-05:00exploratory programmingSo one of the things I find most useful about lisp is the way it facilitates exporatory programming. The last entry described a bactracking algorithm, what would a recursive implementation look like? How about something like this:<br /><pre><br />(defun update (n)<br /> (when (= n 81) (return soln))<br /> (if (nth-value-set n)<br /> (update (1+ n))<br /> (over-possible-digits (d n)<br /> (set-digit n d)<br /> (update (1+ n))<br /> (clear-digit n)))<br /></pre><br />This is almost but not quite valid code, think of it as pseudo-code that describes what I'd like to do, I just haven't quite figured out how yet. But the idea is there. I have 81 possible positions in my 9x9 matrix. Lets call them 0..80. If all the bits of this code do what their names suggest, we'll be in business.<br /><br />This brings up a bit of an issue, development-wise. I don't really don't want to expose details I don't need to, and at the moment I'm not really sure how I'm going to do anything. It's nice to use labels/flet to keep locally important details and assumptions local, and not fill the namespace with little functions that might quite non-general. On the other hand, it can be a pain to debug local functions. It's a trade off.<br /><br />Now I need to flesh out the functions the first bit depended on. I'm to represent the state of things as a 81 element vector, and most of the code follows directly:<br /><pre><br />(defun solve1 (initialstate)<br /> (let ((soln (make-array 81 :initial-contents initialstate)))<br /> (labels ((digit-at (n)<br /> (aref soln n))<br /> (set-digit (n d)<br /> (setf (aref soln n) d))<br /> (clear-digit (n)<br /> (setf (aref soln n) 0)) <br /> (possible-digits (n)<br /> (set-difference<br /> `(1 2 3 4 5 6 7 8 9)<br /> (mapcar #'digit-at (neighbors-of n))))<br /> (nth-value-set-p (n)<br /> (/= 0 (digit-at n)))<br /> (update (n)<br /> (when (= n 81) (return-from solve1 soln))<br /> (if (nth-value-set-p n)<br /> (update (1+ n))<br /> (over-possible-digits (d n)<br /> (set-digit n d)<br /> (update (1+ n))<br /> (clear-digit n)))))<br /> (update 0))))</pre><br />So I've localized most assumptions. I'm representing the sudoku puzzle as a length 81 vector (later i'll specialize this) but I can pass in any sequence. I'm somewhat redundantly using set-digit and clear-digit, but if I want to change my representation, I don't have to touch the core algorithm.<br /><br />I've only got two problems left. I don't know what neighbors-of is, and I don't know what over-possible-digits is. It's pretty clear from the function possible-digits though, that for now at least I can implement this as a simple macro:<br /><pre><br />(defmacro over-possible-digits ((d n) &body body)<br /> `(dolist (,d (possible-digits ,n))<br /> ,@body))</pre><br />This represents a bit of a departure from keeping things localized, but I'll live with that. If it sticks around we can turn this into a macro-let to get it in the body of solve1. I could, of course, have just coded the dolist and commented what it was doing, but this is both self-documenting and allows me to play with the representation without changing update at all, which I think is a good thing.<br /><br />It's the implementation of possible-digits that also gives me an idea of how to go about makeing `nieghbors-of'. What I really want is a way to check what constraints are. That means looking over every position in the matrix in the same row, column, or cell as the current one. We could do this in a 2D way with i,j indices but it is easier to label each position by its row-major index. The whole matrix looks like:<br /><pre> <br /> 0 1 2 3 4 5 6 7 8<br /> 9 10 11 12 13 14 15 16 17<br />18 19 20 21 22 23 24 25 26<br />27 28 29 30 31 32 33 34 35<br />36 37 38 39 40 41 42 43 44<br />45 46 47 48 49 50 51 52 53<br />54 55 56 57 58 59 60 61 62<br />63 64 65 66 67 68 69 70 71<br />72 73 74 75 76 77 78 79 80<br /></pre><br />I'll make a couple of helper functions to jump between 2D subscripts and the indices, hard-coded for 9x9 (at least for now):<br /><pre><br />(defun subs->index (i j)<br /> (+ (* 9 i) j))<br /><br />(defun index->subs (n)<br /> (let ((i (floor n 9)))<br /> (list i (- n (* 9 i)))))<br /></pre>Then neighbors-of is a function that gathers up a list of every index in the same row, column, or 3x3 submatrix as the current `idx'.<br /><pre><br />(defun neighbors-of (idx)<br /> (loop with (i0 j0) = (index->subs idx)<br /> for n below 9<br /> collecting (subs->index i0 n) into res<br /> collecting (subs->index n j0) into res<br /> finally<br /> (loop repeat 3 for i upfrom (* 3 (floor i0 3)) do<br /> (loop repeat 3 for j upfrom (* 3 (floor j0 3)) do<br /> (push (subs->index i j) res)))<br /> (return (remove idx (remove-duplicates res)))))</pre><br />And we have a complete solver:<br /><pre>CL-USER> (vector 0 6 0 0 0 0 0 1 0 0 0 0 6 5 1 0 0 0 1 0 7 0 0 0 6 0 2 6 2 0 3 0 5 0 9 4 0 0 3 0 0 0 2 0 0 4 8 0 9 0 7 0 3 6 9 0 6 0 0 0 4 0 8 0 0 0 7 9 4 0 0 0 0 5 0 0 0 0 0 7 0)<br />#(0 6 0 0 0 0 0 1 0 0 0 0 6 5 1 0 0 0 1 0 7 0 0 0 6 0 2 6 2 0 3 0 5 0 9 4 0 0 3<br />0 0 0 2 0 0 4 8 0 9 0 7 0 3 6 9 0 6 0 0 0 4 0 8 0 0 0 7 9 4 0 0 0 0 5 0 0 0 0<br />0 7 0)<br />CL-USER> (solve1 *)<br />#(5 6 8 4 7 2 3 1 9 2 3 9 6 5 1 8 4 7 1 4 7 8 3 9 6 5 2 6 2 1 3 8 5 7 9 4 7 9 3<br />1 4 6 2 8 5 4 8 5 9 2 7 1 3 6 9 7 6 5 1 3 4 2 8 8 1 2 7 9 4 5 6 3 3 5 4 2 6 8<br />9 7 1)<br /></pre><br />So that's something, we've got a backtracking solver in about 40 lines, if we wanted to play `shortest version' it could be a lot smaller. It's pretty rudimentary, and the input and output are hard to read, but it works.<br /><br />Something to throw darts at in the next installment, anyway.skahttp://www.blogger.com/profile/07206056709352200940noreply@blogger.com