Spider Solitaire

After winning something more than 500 games in a row I have come across a game I have not yet won. I have put 20+ hours into it without finding a win. My previous longest time to a win was 17 hours. So I have decided to analyze the game to see if it is unwinnable.

Deals

Representing the game is mostly straightforward. Using the game it is trivial to see the deals: 

Deals represented (each deal covers piles 1...10):

1. 5s 6s kc 8c 10s 5c ks qs qs 4d
2. 10h 10d 5h 8h 7d 4s 8d 4c 7c 5s
3. 5h kh 4d qd 2s qh 3d 7c ac qc
4. ac 6d jd jc ah 3s ad jc 3d 3h
5. 8c 9c qd jh 9d xc 8d ah 9c 6c
6. 3c 8s js 7h kh as qc 9s 9h 2h

The deals (except for the first) are represented by a CLIPS deal fact for each pile. Lists of cards by deal  are from columns above. (Minus the first card dealt.):

; (deal ?pileInx 1st ... last)

 (deal 1 10h 5h as  8c 3c )

 (deal 2 10d kh 6d  9c 8s )

 (deal 3  5h 4d jd  qd js )

 (deal 4  8h qd jc  jh 7h )

 (deal 5  7d 2s ah  9d kh )

 (deal 6  4s qh 3s 10c as )

 (deal 7  8d 3d ad  8d qc )

 (deal 8  4c 7c jc  ah 9s )

 (deal 9  7c ac 3d  9c 9h )

 (deal 10 5s qc 3h  6c 2h )

Update: to avoid any matching conflations I gave each pile a unique identifier P1...P10. The deals were also matched:
 (deal P1  5s 10h 5h as  8c 3c)
 (deal P2  6s 10d kh 6d  9c 8s)
 (deal P3  kc  5h 4d jd  qd js)
 (deal P4  8c  8h qd jc  jh 7h)
 (deal P5  10s 7d 2s ah  9d kh)
 (deal P6  5c  4s qh 3s 10c as)
 (deal P7  ks  8d 3d ad  8d qc)
 (deal P8  qs  4c 7c jc  ah 9s)
 (deal P9  qs  7c ac 3d  9c 9h)

 (deal P10 4d  5s qc 3h  6c 2h)

Piles

The covered contents of the piles can be discovered by working on a particular pile and trying to empty it. Repeating this procedure, I am left with four undiscovered cards. Undiscovered cards are "XX". The current status is below:

(first deal on piles)

5d	6h	XX	10h
jh	5d	XX	js	XX	3h	jd	qh	2c	10s
3c	5c	kc	ac	XX	2d	2s	6c	4s	4h
7h	7s	8s	10d	4c	kd	8h	2d	ad	10c
kd	9s	6h	5h	7d	9h	2c	2h	6s	9d
5s	6s	kc	8c	10s	5c	ks	qs	qs	4d

These originally hidden cards are represented as CLIPS piles facts. 

; pile (pile ?id ?bot  ... ?top)
;   xx means unknown
  (pile P1  5d  jh 3c  7h kd)
  (pile P2  6h  5d 5c  7s 9s)
  (pile P3  XX  XX kc  8s 6h)
  (pile P4 10h  js ac 10d 6d)
  (pile P5  XX  XX 4c 7d)
  (pile P6  3h  2d kd 9h)
  (pile P7  jd  2s 8h 2c)
  (pile P8  qh  6c 2d 2h)
  (pile P9  2c  4s ad 6s)
  (pile P10 10s 4h 10c 9d)

Game State

To analyze the possible positions in CLIPS. I need to record the state of the game in a reasonably efficient way. I need to extract the information about cards showing on a pile after each move of cards.. I also need to determine what, if any, next card will be uncovered when a last showing card was removed from a pile.  A somewhat complex record structure resulted. After some experimentation with rules, the structure is:

        # ?pileNo $?cards ?pileNo $

Here "#" is a record initiator. "?pileNo" is the index (left to right) of the pile. All the showing cards will be in "$?cards" in the order bottom to top of the pile.  The second occurrence of "?pileNo" acts with the record terminator "$" to end the record unambiguously. I have called the record 'active', but it is in fact a little more since cards down in the showing pile are also there. The initial state of the game has only the initial deal showing:

A count of cards was useful for checking accuracy. For reasons noted above, this final form was changed to 

; active record x 10:
; active ?nCards (# ?pileNo ?pileIndex $?Cards ?pileNo #)x10  

the for the initial deal we have:
    
(active  10 
         P1 5 5s P1 P2 5 6s P2 P3 5 kc P3 P4 5 8c P4 P5  4 10s P5
         P6 4 5c P6 P7 4 ks P7 P8 4 qs P8 P9 4 qs P9 P10 4  4d P10)

Fundamental Functions

It seemed a good idea to have several functions. We need to get the rank and suit of a card:

(deffunction suit (?c)
   (if (= (str-length ?c) 2)
    then (sub-string 2 2 ?c)
    else (sub-string 3 3 ?c)))

(deffunction rank (?c)
   (if (= (str-length ?c) 3)
    then 10
    else (bind ?r (sub-string 1 1 ?c))
         (if (eq ?r "a") then 1 else
         (if (eq ?r "j") then 11 else
         (if (eq ?r "q") then 12 else
         (if (eq ?r "k") then 13 else
         (eval ?r)))))))

We also need to test if one card can 'hold' another allowing us the place the second on the first. Thus 6x can hold 5x.  That will be true if the rank of the holder is one more than the 'holdee'. (We also cover the case where we reach an unknown card XX.) We used this function:

(deffunction  holds (?c1 ?c2)    ; ?c1 can hold onto ?c2 if r1=r2+1
    (if (or (eq ?c1 XX)(eq ?c2 XX)) then (halt))
    (= (rank ?c1) (+ 1 (rank ?c2))))

We must also notice when a sequence of cards are all of the same suit and in rank order, up to down. This is always true of one card. It may be true of 2,3, 4 or more. Our goal is to get a 'straight flush' of 13(!) cards which are then removed. Here is the straight flush function:

(deffunction straightFlush ($?Cards) ; n, n-1, n-2 ... 
   (bind ?x (nth$ 1 $?Cards))
   (progn$ (?y (rest$ $?Cards))
      (if (or (not(holds ?x ?y))
              (neq (suit ?x)(suit ?y)))
       then (return FALSE)
       else (bind ?x ?y)))
    TRUE)

Moves

We need to move a cards, or a straight flush of cards, from one pile to another. The top card moved must be held by the bottom card on the receiving pile. The order of the piles in the active record means there are two possibilities - move left to right or move right to left. We must be sure we have a single record "# ?pileInx ... ?pileInx $". The top card moved can have a descendin straight flush behaind it. The top card being moved must be held by the bottm (rightmost) card in the receiving column:

(defrule moveCardsL2R
    (piles $? ?src $? ?dest $?)
    (pile ?src  $?P)
    (pile ?dest $?)
?f<-(active ?cc
            $?A1 
            ?src  ?spi $?S ?c $?SF ?src  
            $?A2 
            ?dest ?dpi $?D ?ch     ?dest
            $?A3)
    (test (and (holds ?ch ?c)
               (or (= (length$ $?SF) 0)
                   (straightFlush (create$ ?c $?SF)))))
=>
    (bind ?ncc ?cc)(bind $?nS $?S)(bind ?nspi ?spi)
    (if (and (= (length$ $?S) 0)
             (> ?spi 0))
     then (bind ?ncc (+ ?cc 1))
          (bind $?nS (create$ (nth$ ?spi $?P)))
          (bind ?nspi (- ?spi 1)))
    (bind ?g
    (assert 
      (active ?ncc
              $?A1 
              ?src  ?nspi $?nS           ?src  
              $?A2 
              ?dest ?dpi $?D ?ch ?c $?SF ?dest 
              $?A3))
    )
    (if ?g
     then
      (report (fact-index ?f)(fact-index ?g) ?src ?dest ?c $?SF) 
    )
)

(defrule moveCardsR2L
    (piles $? ?dest $? ?src $?)
    (pile ?src  $?P)
    (pile ?dest $?)
?f<-(active  ?cc
            $?A1 
            ?dest ?dpi $?D ?ch     ?dest
            $?A2 
            ?src  ?spi $?S ?c $?SF ?src
            $?A3)
    (test (and (holds ?ch ?c)
               (straightFlush (create$ ?c $?SF))))
=> 
    (bind ?ncc ?cc)(bind $?nS $?S)(bind ?nspi ?spi)
    (if (and (= (length$ $?S) 0)
             (> ?spi 0))
     then (bind ?ncc (+ ?cc 1))
          (bind $?nS (create$ (nth$ ?spi $?P)))
          (bind ?nspi (- ?spi 1)))
    (bind ?g
    (assert (active  ?ncc
                     $?A1 
                     ?dest ?dpi $?D ?ch ?c $?SF ?dest
                     $?A2 
                     ?src ?nspi $?nS ?src
                     $?A3))
    )
    (if ?g
     then
       (report (fact-index ?f)(fact-index ?g) ?src ?dest ?c $?SF) 
    )

)

(defrule moveCardsR2O
    (piles $? ?src $? ?dest $?)
    (pile ?src  $?P)
    (pile ?dest $?)
?f<-(active ?cc
            $?A1 
            ?src ?spi $?S $?SF ?src 
            $?A2 
            ?dest 0           ?dest      ; destination is open
            $?A3)
    (test (> (length$ $?SF) 0))
    (test (straightFlush $?SF))
=>
    (bind ?ncc ?cc)(bind $?nS $?S)(bind ?nspi ?spi)
    (if (and (= (length$ $?S) 0)
             (> ?spi 0))
     then (bind ?cc (+ ?cc 1))
          (bind $?nS (create$ (nth$ ?spi $?P)))
          (bind ?nspi (- ?spi 1)))
    (bind ?g
   (assert 
    (active ?ncc
            $?A1 
            ?src  ?nspi $?nS       ?src
            $?A2 
            ?dest 0         $?SF ?dest
            $?A3))
   )
    (if ?g
     then (report (fact-index ?f)(fact-index ?g) ?src ?dest $?SF) 
    )
)

(defrule moveCardsL2O
    (piles $? ?dest $? ?src $?)
    (pile ?src  $?P)
    (pile ?dest $?)
?f<-(active ?cc
            $?A1 
            ?dest 0            ?dest     ; destination is open
            $?A2 
            ?src  ?spi $?S $?SF ?src
            $?A3)
    (test (> (length$ $?SF) 0))
    (test (straightFlush $?SF))
=>  
    (bind ?ncc ?cc)(bind $?nS $?S)(bind ?nspi ?spi)
    (if (and (= (length$ $?S) 0)
             (> ?spi 0))
     then (bind ?cc (+ ?cc 1))
          (bind $?nS (create$ (nth$ ?spi $?P)))
          (bind ?nspi (- ?spi 1)))
    (bind ?g
    (assert (active ?ncc
                    $?A1 
                    ?dest 0        $?SF ?dest
                    $?A2 
                    ?src  ?nspi $?nS      ?src
                    $?A3))
   )
    (if ?g
     then (report (fact-index ?f)(fact-index ?g) ?src ?dest $?SF) 
    )

) 

Finally we may need to recognize a straight flush of 13 cards and remove it from the active record. It would also happen immediately. For now, we will just halt when that happens. :

(defrule reduce

    (declare (salience 200))

    (or (active $? # ?n ?ni $? kh qh jh 10h 9h 8h 7h 6h 5h 4h 3h 2h ah $ $?)

        (active $? # ?n ?ni $? kc qc jc 10c 9c 8c 7c 6c 5c 4c 3c 2c ac $ $?)

        (active $? # ?n ?ni $? ks qs js 10s 9s 8s 7s 6s 5s 4s 3s 2s as $ $?)

        (active $? # ?n ?ni $? kd qd jd 10d 9d 8d 7d 6d 5d 4d 3d 2d ad $ $?)

  )

=>

  (halt)

  (printout t "REDUCED!" crlf))

Checking Consistency of data

Recording so many card values, especially when they must be discovered by play, is tedious and error prone. At least we can check that they are consistent with the two decks of cards being used in the game. The rules given in the NOTES section at the end are separate from the game rules but used with the same data.

Finding game plays

Running the rules above gives many active states of the game. All possible active states if the rules are correct and complete. We also get the transformation from active fact to active fact. We will use these to check and analyze the system so far.

Here is the graph of the first 'ply' that is all the active states reachable from the starting deal. There are 2700+ so you will need to look at the graph.

Current Status

The analysis discoverd a path of moves which tried to reveal a previously uncovered pile card. Those cards were  denoted 'XX'. This caused the hold function to err on the comparison there and execution to halt. 

Using that result data I was able to recreate the paths followed. One of the longest was the path that caused the error. Note that some inferences go to FALSE. This is not a fact. It means an identical  fact was already recorded. In turn, that implies that we have returned to an earlier situation. When we check paths, that will cause a path to terminate. The inferences, longest path and  relevant facts are given below:

All Inferences

inferences

Longest Paths

The code for this is in the notes at the end.

State facts

STATUS

It seems that the path above ending in <Fact-292> is a path I have not yet tried (Since it revealed the 'XX" that caused the error). I need to use the active facts and the path to extract a readable sequence of moves. This will also test the veracity of the state transformations. I will also add a proof of correctness for the rules if they check OK.

TBA



============================================================

NOTES

rules for checking description consistency

We remove a card from the decks  when it appears in a pile, active or deal record. . If any cards remain in any of these structures, they were not matched against a deck card - probably there were too many occurrences of the card.  Once that is corrected, if any cards remain in decks, they are candidates for the unknown pile cards.

; ======== rules for data checks
; check that all cards are accounted for
(defrule checkDeals
?f<-(decks $?A ?c $?B)
?g<-(deal ?n $?Da ?c $?Db)
=>
    (retract ?f ?g)
    (assert (decks $?A $?B)
            (deal ?n $?Da $?Db)))

(defrule checkPiles
?f<-(decks $?A ?c $?B)
?g<-(pile ?n $?Da ?c $?Db)
=>
    (retract ?f ?g)
    (assert (decks $?A $?B)
            (pile ?n $?Da $?Db)))

(defrule checkActive
?f<-(decks $?A ?c $?B)
?g<-(active $?Da ?c $?Db)
=>
    (retract ?f ?g)
    (assert (decks $?A $?B)
            (active $?Da $?Db)))

rules for detecting inference paths

(defrule path1

    (or (inf ?fact1  " = right2open => " ?fact2)

        (inf ?fact1  " = left2open => " ?fact2)

        (inf ?fact1  " = right2left => " ?fact2)

        (inf ?fact1  " = left2right => " ?fact2))

    (path $?P ?fact1)

=>

    (assert (path $?P ?fact1 ?fact2  )))

; might shorten path with reveal

(defrule path2

   (inf ?fact1 " = reveal => " ?fact2)

   (path $?P ?fact1)

=>

   (assert (path  $?P ?fact1 ?fact2 )))

(defrule reportLongestPathFact

   (declare (salience -50))

?f<-(path $?P)

  (forall (path $?X)

     (test (>= (length$ $?P)(length$ $?X))))

=>

  (printout t crlf "path " ?f crlf)

  (bind ?n 0)

  (progn$ (?x $?P)

    (printout t " " ?x)     

    (if (>= ?n 5)

     then (printout t crlf)

          (bind ?n 0)

     else (bind ?n (+ ?n 1)))))

UPDATE Aug 5

Checking reveals it is not a good idea to have reveal as a rule. Rather, reveal must be taken care of immediately in the RHS. On the other hand, may rethink the inference capture instead.

The snail puzzle problem made me overlook another BrainBashers puzzle I liked. Actually it was a series of puzzles (or could be seen as such). They are called brain bashers' quizzes: there are some multiple choice question with answers a-D and you are supposed to find the answers that are consistent. The original puzzle was here:

BrainBashers Entry Exam Section B

Here is the gist. If we know then answer to a question we know something about the other answers. The right answer to question 1 tells us something about question 2 and so on:

1. The answer to Question 2 is:
            A. B      B. A      C. D      D. C
2. The answer to Question 3 is:
            A. C      B. D      C. B      D. A
3. The answer to Question 4 is:
            A. D      B. A     C. C      D. B
4. The answer to Question 1 is:
            A. D      B. C     C. A      D. B

Not too hard to solve. Here the choice of one answer  constrains the other answers. We just want a consistent set of answers. We can work trough following the statements one-by-one recording our deductions:
1=A => 2=B => 3=D => 4=B => 1=C
1=B => 2=A => 3=C => 4=C => 1=A
1=C => 2=D => 3=A => 4=D => 1=B
The first three result in contradictions. We have performed a reductio on each of the first three possibilities.

The only remaining is consistent:     1=D => 2=C ->3=B => 4=A => 1=D

So we can solve this by simple deduction. We could also solve it by examining all the possible sets of answers A,A,A,A ... D,D,D,D. Ltes try the deduction for now.

The descriptions of the answers for each problem can be seen as giving a collection of if-then conditionals.  For example, "If the answer to 1 is a then the answer to 2 is b and so forth. We give them all without further comment:

(deffacts claims
   (ans 1 a => 2 b)(ans 1 b => 2 a)(ans 1 c => 2 d)(ans 1 d => 2 c)
   (ans 2 a => 3 c)(ans 2 b => 3 d)(ans 2 c => 3 b)(ans 2 d => 3 a) 
   (ans 3 a => 4 d)(ans 3 b => 4 a)(ans 3 c => 4 c)(ans 3 d => 4 b)
   (ans 4 a => 1 d)(ans 4 b => 1 c)(ans 4 c => 1 a)(ans 4 d => 1 b) 
   
   (world)
)

We have added a world fact at the end. This is because we will test a possible world with each choice for the true answer to question 1:

 (defrule startWorld
   (world)
   (ans 1 ?x => ? ?)
=>
   (assert (world # 1 ?x)))  ;  # separates world facts

We find out more about the worlds by comparing what the say so far to the if-then facts we recorded s data. The if-ten clains were given above. Logician speak of a conditional as be "IF antecedent THEN consequent". If the antecedent is true in a world then its consequent must also be. Our rule just adds a consequent if an antecedent is known - so long as the test shows the consequent is new information. We also must ignore things like (ans  1 a  1 a) or our rule could be caught in a infinite deduction! If we do extend a world, we update what we know about if to be complete by retracting the old and asserting the new.

(defrule extendWorld                "= Modus Ponens"
?f<-(world $?W1  # ?n ?a $?W2)
    (ans ?n ?a => ?n2 ?a2)
    (test (and (or (neq ?n ?n2)
                   (neq ?a ?a2))   
               (not (member$ (create$ ?n2 ?a2) $?W1))
               (not (member$ (create$ ?n2 ?a2) $?W2))))
=>
   (retract ?f)
   (assert (world $?W1  # ?n ?a $?W2 # ?n2 ?a2)))


Of course we are looking for worlds that are consistent. We can immediately reject any that are inconsistent. Four our representation that means the have # ?n ?a and later on have a different value for ?n,  i.e.:  ?n ?b&~?a.  So the code below retract at once any fact with such a contradiction:

(defrule contradictory
    (declare (salience 10))
?f<-(world $? # ?i ?a $? # ?i ?b&~?a $?)
=>

    (retract ?f))

Now our code will only retain consistent, that is possible worlds. There might be more than 1.  If the puzzle setter erred - or more likely, we erred collecting the conditionals. It might be nice to have a rule to print any worlds still left after all the above worlds have done their work:

(defrule possible
   (declare (salience -20))
?f<-(world $?W)
    (test (> (length$ $?W) 0))  ; ignore world where we know nothing
=>
   (printout t "Possible: " $?W " " ?f crlf))

Here is the result:

CLIPS> Loading Selection...
Defining deffacts: claims
Defining defrule: startWorld +j+j+j
Defining defrule: extendWorldDescribed +j+j+j
Defining defrule: contradictory +j+j
Defining defrule: possible +j+j
CLIPS> (reset)
CLIPS> (run)
Possible: (# 1 d # 2 c # 3 b # 4 a) <Fact-33>
CLIPS> 

next puzzle TBA

BrainBashers Entry Exam Section A

Do we still have code that solves it?

8 Queens Problem

The eight queens problem is a real life problem for chess players. The task is to place eight queens on a chessboard so that none attacks any other. A solution is shown below:

(1 5 8 6 3 7 2 4)

Q
				Q
							Q
					Q
		Q
						Q
	Q
			Q

So how would you explain, to a child, how to reach such a solution? One possibility might be this narrative: Place the first queen in square 1 of row 1. Place the next in the next row at column 1 and look for attacks. If there are any,and there are now columns left, move this queen to the next column. If there are no columns left, go back to the previous queen, move it  over 1 column and then come back the the . When all 8 queens are on the board you're done.

To explain to a computer we will talk on the same level but with carefully controlled expressions. The language we will use her will be the language of rules. Since there is no chessboard in the computer we need to capture the state of th it at each point some other way. We choose the keep facts like this:  (queens 1 5 8 6 3 7 2 4). It is to be interpreted as giving the row and column for each of the queens 1..8. The column for the 4th queen  is the 4th value in the list, etc. We know how many queens we need but we start with none.  So start with two pieces of information:

(deffacts setup

   (nQueens 8)   ; can change number for any size

   (queens)

)

With an ordered list queens, they can never be in the same row. We easily check columns j if some column number appears twice.

(defrule checkCol

   (declare (salience 100))    ;must be check before deciding!

   (queens $? ?c $? ?c)

   =>

   (assert (ATTACK)))

On the board above, we can see that the queens do not attack on diagonals either. With the list, we will have to calculate whether (1,1),(2,1), (3,3)  etc. share rank, file or diagonal. The row is the list location. The column is the entry.  We use the length$ CLIPS function to determine the number of items in a list. It we look at the whole list we know where the last one is. If we find something in the list its position is the number before +1. In out rule we will let the queen fact be matched twice.

What about the calculation? In the diagram below, Queen 1 attacks queen 3 because we can get to Q3 by moving down 2 and right 2 from Q1. Vice versa, we can move up 2 rows and left two columns to go from Q3 to Q1. On any diagonal, the up/down and left/right counts will be the same. For Q1 and Q3, this is true,  For Q2 and Q3 this is not true.

Q1	Q2
		Q3

Whenever we want to know if one queen attacks another we only need find their rows and columns and ask whether the absolute values of the respective differences are equal. We let the queen fact be matched twice to simplify arithmetic.

(defrule checkDiag

   (declare (salience 100))    ;must be check before deciding!

   (queens $?Qs)

   (queens $?A ?c2 $? ?c1)

   (test (= (abs (- (+ (length$ $?A) 1) (length$ $?Qs)))

            (abs (- ?c1 ?c2))))

=>

   (assert (ATTACK)))

Now let us return to our overall process as described above. To make it a little more definite we may construct a decision matrix. The method is creating a table for what situations call for what actions. That requires we know how to recognize the various situations. From the above some are: 1) Do we have all queens yet? 2) Is the current list of queen locations OK? 3) Is there more column in this row? Let’s see if these are enough.

We construct a decision matrix relating situations defined by our questions to actions we may need to take. Given three question, each true or false, there will be 8 possible arrangements of questions. The actions we have mentioned above are four: 1) The puzzle is solved 2) (all is OK) we can add a new queen 3) We try the next column 4) we re-try the previous queen in a new column (and start over with the last queen).  This full beginning decision table is shown below.

All queens known?	ANy Attacks?	Next column?	ACTION/state
Y	N	Y	solved
Y	N	N	solved
Y	Y	Y	Try next column
Y	Y	N	Retry previous with new column
N	N	Y	Add a queen
N	N	N	Add a queen
N	Y	Y	Try next column
N	Y	N	Retry previous with new column

We can reduce the table using logic. We can eliminate don’t cares. We can move the situation rows that have the same action together. We can consolidate rows were a question being true of false make no difference in action. We then get the the following:

All queens known?	Any attacks?	Next column?	ACTION
Y	N		solved
N	N		Add a queen
	Y	Y	Try next column
	Y	N	Retry previous with new column

It is not necessary to reduce the decision matrix. However, doing so can reduce the number of situations we must recognize.

How do we answer the questions about a situation in our program? Recall that the situation will be something like (queens 1 5 8 6 3 7 2 4) or like (queens 1 5 8 6 2).  So a list is complete when its length is the number of queens we need.

Since we have an attack function, we can use it to assert a fact whenever the queen's’ list has one. We assume we have used our attack function to check for any  attack. So we can recognize a solution with the following rule:

(defrule Solved

   (nQueens ?nq)

   (queens $?Qs)

   (test (= (length$ $?Qs) ?nq))

   (not (ATTACK))

=>

   (halt)

   (printout t $?Qs crlf))

When to add a queen? When there are no attacks  but we do not have all the queens.

(defrule addQueen

   (nQueens ?nq)

?f<-(queens $?Qs)

   (test (< (length$ $?Qs) ?nq))

   (not (ATTACK))

=>

   (retract ?f)

   (assert (queens $?Qs 1)))

Notice that we capture the old index during the match. That index is used to delete the old queens fact. The new queens fact has one more queen, initially in column 1.

Our third situation was when the current queens have an attack but there is a next row. We ‘move’ the queen over a column. (We also remove the attack fact since we have a new queens):

‘(defrule nextColumn

   (nQueens ?nq)

?f<-(queens $?Qs ?col)

   (test (<= ?col ?nq))

?g<-(ATTACK)

=>

   (retract ?f ?g)

   (assert (queens $?Qs (+ ?col 1))))

Finally, if there is no next column, we have exhausted trys at this point and must backtrack. That is we give up the current queen and return to the previous to try a new value there. For us that just means drop the last and increment that before the last by 1:

(defrule backtrack   ; exhausted all possibilities!

   (nQueens ?nq)

?f<-(queens $?Qs ?qBefore ?q)

   (test (> ?q ?nq))    

?g<-(ATTACK)

=>

   (retract ?f ?g)

   (assert (queens $?Qs (+ ?qBefore 1))))

Although we planned our logic carefully, note the importance of or list of queens. It records the queens in order, but we also use it to go back to the previous queen. Any list can record things in order but when we always add and extract from the same end, we get a stack.  We are using as a stack. Like a pile of plates, the first plate down is the last plate out and vice versa. Many approaches use this to control their operation. Here we used it to set each new queen in terms of the old and to return from the current failed queen to the previous.

If you think about the history of the process, we are searching a tree of possibilities. The tree of queen positions is shown below. A Stack is a convenient way of organizing how deep we are in the tree and remembering how to retreat to the previous level - all the way to the origin if we must.

And what are we doing with the stack? We are exploring the state space. The state space is all the possible choices that could be made. The stack holds the set of choices currently being considered. The space gets large very quickly. Basically is nn if all choices are acceptable everywhere and n! if the choices must exhaust the possibilities. We show the tree for 4 queens below, with arrows to connect the tested choices. Successful choices have bold arrows.

INSERT FINISHED GRAPHS HERE

NOTES

The code finds the solution for eight queens in a second  on a PC. It can use any strategy because we accounted for all logical possibilities in our rules.

Complete code:

The code below contains other options for checking attacks. The function and rule using it have been commented out.

; Queens by Backtracking

(deffacts setup

   (nQueens 8)

   (queens)

)

; === moves

; ----- if OK

(defrule addQueen

   ;(declare (salience -10))

   (nQueens ?nq)

?f<-(queens $?Qs)

   (not (ATTACK))

   (test (< (length$ $?Qs) ?nq))

=>

   (retract ?f)

   (assert (queens $?Qs 1)))

(defrule Solved

   (nQueens ?nq)

   (queens $?Qs)

   (not (ATTACK))

   (test (= (length$ $?Qs) ?nq))

=>

   (halt)

   (printout t $?Qs crlf))

; ----- if ATTACKed

(defrule nextColumn

   (nQueens ?nq)

?f<-(queens $?Qs ?col)

   (test (<= ?col ?nq))

?g<-(ATTACK)

=>

   (retract ?f ?g)

   (assert (queens $?Qs (+ ?col 1))))

(defrule backtrack   ; exhausted all possibilities!

   ;(declare (salience 30))

   (nQueens ?nq)

?f<-(queens $?Qs ?qBefore ?q)

   (test (> ?q ?nq))    ; changed

?g<-(ATTACK)

=>

   (retract ?f ?g)

   (assert (queens $?Qs (+ ?qBefore 1))))

; ==== ATTACKures

(defrule exhausted

   (declare (salience 30))

   (nQueens ?nq)

   (queens $? ?q)

   (test (> ?q ?nq))     ; changed

=>

   (assert (ATTACK)))

   

; Deleted the next two constructs in favor of avoiding functions and simpler rules

;(deffunction queenAttack (?r1 ?c1 ?r2 ?c2)

;   (if (or (= ?c1 ?c2)

;           (= ?r1 ?r2))

;    then TRUE

;    else (= (abs (- ?r1 ?r2))(abs (- ?c1 ?c2)))))

;

;(defrule attacks

;    (declare (salience 10))

;    (queens $?A ?c1 $?B ?c)

;    (not (ATTACK))

;    (test (queenAttack (+ (length$ $?A) 1)

;                       ?c1

;                       (+ (length$ $?A) 1 (length$ $?B) 1) ; changed

;                       ?c))

;=>

;    (assert (ATTACK)))

;

; the rules below may fire multiple times but once is just enough

; If you condition these rules with (not (ATTACK))  you avoid the extra firings

(defrule checkCol

   (declare (salience 100))

   (queens $? ?c $? ?c)

   =>

   (assert (ATTACK)))

(defrule checkDiag

   (declare (salience 100))

   (queens $?Qs)

   (queens $?A ?c2 $? ?c1)

   (test (= (abs (- (+ (length$ $?A) 1) (length$ $?Qs)))

            (abs (- ?c1 ?c2))))

=>

   (assert (ATTACK)))