Rules As Programming

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):

5s 6s kc 8c 10s 5c ks qs qs 4d
10h 10d 5h 8h 7d 4s 8d 4c 7c 5s
5h kh 4d qd 2s qh 3d 7c ac qc
ac 6d jd jc ah 3s ad jc 3d 3h
8c 9c qd jh 9d xc 8d ah 9c 6c
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.