#|
ap5 example - sudoku
The first part of this example keeps track of state and makes
deductions according to stated rules. As compared to a solution in a
normal programming language, the first advantage is the ability to
abstract from data structures to relations, e.g., from an array of
lists of possible numbers to a three place relation,
(possible row column number).
This same advantage would be achieved by using a relational database
to hold the data. Along with this advantage comes the ability to
describe patterns in a relational language. For instance, in order to
find tuples of the possible relation that should be removed because
the same number is already known (certain) to be in a different
position of the same row, it is possible to write a query rather than
a program.
In comparison with a database language, a significant advantage of
ap5 is the ability to trigger rules on conditions expressed in the
relational language. I leave aside for now comparisons between
the ap5 relational language and SQL and between lisp and other
languages for describing computations not specifically related to
the database.
Even given a data model and the intent to use triggering, there is
some choice about how to map the computation onto atomic transitions.
At one extreme, one could imagine using only consistency rules.
In this case a user might type (++ certain 1 2 3) to say that at row 1,
column 2, he is placing the value 3, and that would either cause an
abort because the update is inconsistent with the previous state, or
the new state would contain not only the new tuple but also everything
that could be derived from it by the rules. In fact, the user could
enter an entire puzzle at once by doing
(atomic (++ certain 1 2 3) (++ certain 1 5 7) ...) and deduce all
possible conclusions in a single state transition.
This may be appropriate for simple enough sets of rules, but not for
sets of rules that interact in complicated ways. In particular, ap5
consistency rules can cause other consistency rules to trigger, but
the intent of the design of ap5 is that this should not go on
indefinitely in a single atomic transition. The implementation
currently breaks after a limited number of such cycles to ask the user
to check that it's not in an infinite loop. This can be turned off
(set *rule-cycle-limit* to nil), but that would not be using ap5 as
intended.
At the other extreme, one might make every deduction by a rule create
a new state. Or one could choose some point in between, where a
limited amount of deduction is done by the consistency mechanism and
more is done by automations. Below I use consistency only for
ruling out possible tuples due to existing certain tuples, which
actually does not lead to any interactions among consistency rules.
I use automations to add new certain tuples, which of course can
cause more possible tuples to be ruled out by consistency rules.
Many other rules are possible and desirable, and I list some of them
below in comments as exercises for the reader.
http://www.scanraid.com/sudoku.htm describes many more rules.
|#
(in-package :ap5)
;; data model (3 relations)
;; I use integer as my type constraints, though we could catch a few
;; more errors by restricting the range to [1,9].
;; Note in all relation definitions, size and representation are
;; annotations which are purely optional and don't affect semantics.
(defrelation possible :types (integer integer integer)
:documentation "(possible row col n) - n could go at position row,col"
:representation full-index
:size ((output output output) 729))
(defrelation certain :types (integer integer integer)
:documentation "(certain row col n) - n MUST go at position row,col"
:representation full-index
:size ((output output output) 81
(input input output) 1
;; we could actually supply all of the others ...
(output output input) 9))
;; 9x9 board divided into 3x3 "blocks"
;; There are two obvious approaches here, a computed relation or a
;; stored relation. Take your choice.
#+ignore
(defrelation block :types (integer integer integer)
:documentation "(block row col n) - position row,col is in block n"
:representation full-index
:size ((output output output) 81
;; we could again supply all of the others ...
(input input output) 1))
;; block data upper left is block 1, upper middle block 2, etc.
;; The need to initialize block is one price of the stored approach.
;; Since I have no intention of ever changing it, I initialize on load.
#+ignore
(loop for row from 1 to 9 do
(loop for col from 1 to 9 do
(++ block row col (+ 1 (* 3 (floor (1- row) 3)) (floor (1- col) 3)))))
;; alternative, last line a direct translation of the line above
(defrelation block
:documentation "(block row col n) - position row,col is in block n"
:definition
((x y z) s.t.
;; might also want to require (integer x) (integer y) (integer z)
;; (<= x 10) (<= y 10) (<= z 10)
;; (>= x 1) (>= y 1) (>= z 1)
(+ 1 (+ (* 3 (floor (- x 1 =) 3 =) =) (floor (- y 1 =) 3 =) =) z)))
#| to help you interpret that last line
(expanddescription
'((x y z) s.t.
(+ 1 (+ (* 3 (floor (- x 1 =) 3 =) =) (floor (- y 1 =) 3 =) =) z)))
;; I've altered the output below to improve clarity
=>((X Y Z) S.T.
(E ( <</3>*3> </3> X1286 </3> X1289)
(AND (FLOOR 3 </3> X1286)
(FLOOR 3 </3> X1289)
(+ 1 Z)
(+ 1 X)
(+ 1 Y)
(+ <</3>*3> </3> )
(* 3 </3> <</3>*3>))))
|#
;; a small amount of code
(defun reinitialize () ;; start a new problem
(with-dormant-rules t ;; avoid rules in changing from any previous state
(set-listof (x y z) s.t. (certain x y z) nil) ;; nothing certain
;; everything is possible
(loop for i from 1 to 9 do
(loop for j from 1 to 9 do
(loop for k from 1 to 9 do (++ possible i j k))))))
(defun show (&optional (stream t)) ;; show the state of the board
(loop for row from 1 to 9 do
(loop for col from 1 to 9 do
(format stream "(~a,~a)" row col)
(forany x s.t. (certain row col x)
(format stream "=~a " x)
ifnone (format stream " ")))
(format stream "~%")
(loop for col from 1 to 9 do
(loop for p from 1 to 9 when (possible row col p)
do (format stream "~a" p))
(let ((c (loop for p from 1 to 9 when (possible row col p)
count t)))
(loop for i from c to 9 do (format stream " "))))
(format stream "~%~%")))
;; consistency rules just for recognizing inconsistent states
(alwaysrequired certain-implies-possible
(A (x y z) (implies (certain x y z) (possible x y z))))
;; only one number can be certain in a given position
;; (could have been expressed as a cardinality constraint in certain defn)
(alwaysrequired optional-certain-iio
(A (x y a b) (implies (and (certain x y a) (certain x y b)) (= a b))))
;; consistency rules that rule out possibilities
;; anything certain rules out all other possibilities for the same place
(alwaysrequired certain-no-others-possible
(A (x y z w) (implies (and (certain x y z) (possible x y w)) (= z w)))
:repair (lambda (x y z w) (-- possible x y w)))
;; a given number can appear at most once in a row
(alwaysrequired optional-for-row
(A (x y1 y2 z) (implies (and (certain x y1 z) (possible x y2 z)) (= y1 y2)))
:repair (lambda (x y1 y2 z) (-- possible x y2 z)))
;; optional-for-col
(alwaysrequired optional-for-col
(A (x1 x2 y z) (implies (and (certain x1 y z) (possible x2 y z)) (= x1 x2)))
:repair (lambda (x1 x2 y z) (-- possible x2 y z)))
;; optional-for-block
(alwaysrequired optional-for-block
(A (x1 x2 y1 y2 b z)
(implies (and (certain x1 y1 z) (possible x2 y2 z)
(block x1 y1 b) (block x2 y2 b))
(and (= x1 x2) (= y1 y2))))
:repair (lambda (x1 x2 y1 y2 b z) (-- possible x2 y2 z)))
;; automation rules to add results
;; when there's only one possibility for a position, it's certain
(defautomation start-last-possible
((x y z) s.t.
(start (and (possible x y z)
(not (certain x y z))
(not (e (w) (and (possible x y w) (not (= z w))))))))
(lambda (x y z)
(format t "~% derived (++ certain ~a ~a ~a)" x y z)
(++ certain x y z)))
#|
I suggest adding some of these rules as an exercises for the reader.
if all possible positions for a number in a given block are in the same
row then that number is not possible in that row outside that block
[above switch row/col]
[2 above switch row/block]
[above switch row/col]
twins/triplets ?
a number that is possible at only one place in a row/col/block is certain
|#
#|
In case the rules fail to solve a problem (very likely for the set I've
supplied), the rest of the example is a program to search for a solution.
This uses the ap5 history mechanism, also used to build ap5 "transactions".
|#
;; for use below, how many possible numbers at a give position
(defrelation npossible :derivation (cardinality possible (input input output)))
;; in case history recording is turned off
(when (eql t global-history) (setf global-history nil))
(defun search-for-solution (&aux row col (minp 10) n)
;; starting from current state
;; returns t if solution found (leaves state with solution),
;; returns nil if no solution (leaves initial state)
;; simplest heuristic:
;; try a possibility of a position with fewest possibilities
;; [loop below could be replaced with access to an extreme rel]
(loop for (r c n) s.t. (npossible r c n)
when (and (> n 1) (< n minp))
do (setf minp n row r col c))
(when (null row) (return-from search-for-solution t))
(setf n (any n s.t. (possible row col n)))
(format t "~% try row ~a col ~a = ~a" row col n)
(history-label 'start) ;; establish a backtracking point in history
;; catching ALL errors here is clearly too general (*)
(multiple-value-bind (val err) (ignore-errors (++ certain row col n) t)
;; now either val is t or val is nil and err is an error
;; note - the error may be from a later transition due to automation
(when (and val (search-for-solution))
(return-from search-for-solution t))
;; just in case you want to know the error (or confirm it's an abort)
(when err (format t "~% error: ~a" err)))
(format t "~% failed row ~a col ~a = ~a" row col n)
(undo-to 'start) ;; backtrack to above established point
(history-label 'start) ;; well, then that row/col/n must not be possible
(multiple-value-bind (val err) (ignore-errors (-- possible row col n) t)
(when (and val (search-for-solution))
(return-from search-for-solution t))
(when err (format t "~% error: ~a" err))) ;; as above
(format t "~% failed NOT row ~a col ~a = ~a" row col n)
(undo-to 'start)
nil)
#|
(*) Above I use ignore-errors which is clearly too general.
AP5 was originally written before the common lisp condition system
existed. Conditions were partly added later but this could use some
more work. (In fact, it is still undocumented!)
The errors that actually are printed by the examples below are:
- The following situation is prohibited by ...
No reaction to consistency rules.
This is actually a condition of class rules-do-only-noops.
It would be more appropriate to catch the more general class
condition consistency-violation or even atomic-abort.
- A throw or error is propogating out of the automation rule ...
If this occurs, ... pending rule invocations will be lost.
This is much more common since most aborts occur as a result of
an update generated by an automation rule. If there are more
automations on the queue after the one that aborts it is not clear
whether they should be run, and the code that catches that case
(and normally asks the user) currently calls cerror.
It seems clear at this point that ap5 should never call cerror or
error but should always signal more specific conditions that can be
caught by their types.
|#
#|
demo
[start an ap5 image]
[load this file]
(in-package :ap5)
(reinitialize)
;; sample data from LATimes
(loop for (x y z) in
'((1 1 8)(1 4 2)(1 6 6)(1 9 7)
(2 2 1)(2 4 7)(2 6 8)(2 8 6)
(3 3 3)(3 7 4)
(4 3 6)(4 5 1)(4 7 3)
(5 1 9)(5 9 8)
(6 3 4)(6 5 6)(6 7 2)
(7 3 5)(7 7 7)
(8 2 2)(8 4 1)(8 6 7)(8 8 3)
(9 1 3)(9 4 5)(9 6 4)(9 9 9))
do (format t "~% (++ certain ~a ~a ~a)" x y z) (++ certain x y z))
(show)
(search-for-solution)
;; last in emma's book (diabolical)
(reinitialize)
(loop for (x y z) in
'((1 1 8)(1 4 2)(1 6 9)(1 9 7)
(2 3 9)(2 4 3)(2 6 6)(2 7 2)
(3 1 3)(3 9 6)
(4 3 7)(4 4 6)(4 6 1)(4 7 3)
(5 2 3)(5 8 5)
(6 3 8)(6 4 9)(6 6 3)(6 7 6)
(7 1 1)(7 9 8)
(8 3 3)(8 4 1)(8 6 8)(8 7 7)
(9 1 9)(9 4 4)(9 6 7)(9 9 3))
do (format t "~% (++ certain ~a ~a ~a)" x y z) (++ certain x y z))
(show)
(search-for-solution)
;; next last in emma's book (diabolical)
(reinitialize)
(loop for (x y z) in
'((1 4 3)(1 6 6)(1 9 5)
(2 2 9)(2 4 4)(2 9 6)
(3 5 8)(3 6 2)(3 7 1)
(4 2 2)(4 7 4)(4 8 6)
(5 2 6)(5 4 9)(5 6 4)(5 8 7)
(6 2 5)(6 3 8)(6 8 3)
(7 3 9)(7 4 8)(7 5 4)
(8 1 5)(8 6 9)(8 8 1)
(9 1 8)(9 4 1)(9 6 7))
do (format t "~% (++ certain ~a ~a ~a)" x y z) (++ certain x y z))
... 8 derived
(show)
(search-for-solution)
try row 2 col 8 = 2
derived (++ certain 7 8 5)
try row 1 col 7 = 8
derived (++ certain 1 8 4)
... 30 more derived
error: ...
failed row 1 col 7 = 8
derived (++ certain 1 7 7)
try row 7 col 7 = 2
derived (++ certain 7 9 7)
... 32 more derived
error: ...
failed row 7 col 7 = 2
derived (++ certain 7 7 6)
try row 2 col 7 = 3
derived (++ certain 2 1 7)
derived (++ certain 2 3 7)
error: ...
failed row 2 col 7 = 3
derived (++ certain 2 7 8)
... 33 more derived
error: ...
failed NOT row 2 col 7 = 3
failed NOT row 7 col 7 = 2
failed NOT row 1 col 7 = 8
failed row 2 col 8 = 2
derived (++ certain 2 8 8)
try row 6 col 9 = 9
derived (++ certain 4 9 1)
... 36 more derived
error: ...
failed row 6 col 9 = 9
derived (++ certain 6 9 2)
... 16 more derived
try row 5 col 3 = 3
derived (++ certain 5 1 1)
... 16 more derived
error: ...
failed row 5 col 3 = 3
derived (++ certain 5 3 1)
... 7 more
try row 1 col 8 = 2
derived (++ certain 2 7 3)
... 17 more
T
|#