;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; FreeCellWorld
;;; Free cell game playing domain
;;;
;;; Originally written by Nolan Andres and Robert HillHouse (CS
;;; 486/686 Final Project) 
;;;
;;; Adapted from TLPLAN to strips. In particular removed all functions
;;; and arithmetic. 
;;;
;;; Description
;;; ------------
;;; Freecell is a solitaire game that comes with Windows.
;;; If you haven't seen it before:
;;;  One has 8 columns of cards, 4 freecells and 4 homecells. The
;;;  cards start in "random" (random according to MS's brain damaged RNG)
;;;  piles in the 8 columns. We can move a card in the following ways: 
;;;  1. we can move any card that is on top of a column to an empty free
;;;     cell. The free cells only take one card each.
;;;  2. we can move any card from a free cell or from top of a column to
;;;  a home cell if that home cell contains a card of the same suit
;;;  and is one lower in value (aces have value 1, Jacks 11, Queens
;;;  12, Kings 13, and to make things more symmetric we start the
;;;  homecells off containing "phone" cards with value 0.
;;;  3. we can move any card from the  top of a column or from a
;;;  freecell to the top of another column if that column currently holds
;;;  a card with an opposite colour suit that has one higher
;;;  value. 
;;;  4. we can move any card from a free cell or on top of a column to a
;;;  new column if there are less than 8 columns.
;;; The aim is to get all of the card home. The problems show quite a
;;; good variety of difficulty. 
;;; With macro-moves  (actions that generate worm-holes in the search
;;; space) and hand-tailored heurisics tlplan is able to solve about
;;; 90% of the randomly generated games. Unfortunately, the
;;; macro-moves need action descriptions that include recursive 
;;; updates...i.e., beyond adl, and the heurisics need functions and
;;; arithmetic also beyond adl.
;;;
;;; However the original version of the domain was done by two
;;; students in my AI class, and without heuristics and marco moves
;;; they were able to solve problems containing reduced number of
;;; cards in each suit. 
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Cards are represented by the symbols 
;;;		ca, c2, ..., cj, cq, ck. - clubs
;;;		da, d2, ..., dj, dq, dk. - diamonds
;;;		ha, h2, ..., hj, hq, gk. - hearts
;;;		sa, s2, ..., sj, sq, sk. - spaces
;;;		(c0, d0, h0, s0 indicate an empty card of a certain suit).
;;; 
;;; Where:
;;;		c = clubs, d = diamonds, h = hearts, s = spades.
;;;		a = ace, j = jack, q = queen, k = king.
;;;
;;; Static Predicates (In Tlplan these were functions)
;;; 
;;; (value card val)   --- the face value of the card. (1, ..., 13)
;;; (suit card st)     --- the suit of the card. (c, d, h, s)
;;;   e.g., (value ca 1) (suit ca c) 
;;; (successor n' n)   --- n' = n+1, for n=0,...,12, n'=1,...,13
;;;                        a cheap and dirty way to avoid using
;;;                        numbers. 
;;;                        Note 0 does not have a predecessor. This
;;;                        serves act as > 0 precondition
;;;
;;;
;;; Dynamic Predicates:
;;;
;;; (on card1 card2)	-- card1 is on card2
;;; (incell card)	--- card is in a freecell.
;;; (clear card)	--- card is clear (i.e., on top of a column).
;;; (cellspace n)	--- there are n free freecells.
;;;                                n = 0, 1, 2, 3, or 4
;;; (colspace n)	--- there are n free columns. n=0,..,8
;;; (home card)		--- card is a top card in a home stack.
;;;			    we use the special (home c0),
;;;			    (home d0), (home h0), (home s0).
;;;			    to indicate that home is empty for a
;;;			    particular suit.
;;; (bottomcol card)	--  card is at the bottom of a stack.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Initialization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(clear-world-symbols)			;Remove old domain symbols

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 1. The world symbols.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(declare-described-symbols
 (predicate on 2)
 (predicate incell 1)
 (predicate clear 1)
 (predicate cellspace 1)
 (predicate colspace 1)
 (predicate home 1)
 (predicate bottomcol 1)
 (predicate canstack 2)
 (predicate suit 2)
 (predicate value 2)
 (predicate next-in-suit 2)
 (predicate successor 2)
 (predicate maxcard 1)
 (function number-home 0)
 )

(declare-defined-symbols
 (predicate set-computed-colspace 0)
 (predicate accumulate-stack 1)
 (predicate print-home-and-free-cells 1)
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 2. Define the static symbols.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions and predicates that never change. 
;;; These nust be specified as part of the initial state!

(define (value-facts)
   (value c0 0) (value cA 1) (value c2 2) (value c3 3) 
   (value c4 4) (value c5 5) (value c6 6) (value c7 7) 
   (value c8 8) (value c9 9) (value c10 10) (value cJ 11) 
   (value cQ 12) (value cK 13)
   (value d0 0) (value dA 1) (value d2 2) (value d3 3) 
   (value d4 4) (value d5 5) (value d6 6) (value d7 7) 
   (value d8 8) (value d9 9) (value d10 10) (value dJ 11) 
   (value dQ 12) (value dK 13)
   (value h0 0) (value hA 1) (value h2 2) (value h3 3) 
   (value h4 4) (value h5 5) (value h6 6) (value h7 7) 
   (value h8 8) (value h9 9) (value h10 10) (value hJ 11) 
   (value hQ 12) (value hK 13)
   (value s0 0) (value sA 1) (value s2 2) (value s3 3) 
   (value s4 4) (value s5 5) (value s6 6) (value s7 7) 
   (value s8 8) (value s9 9) (value s10 10) (value sJ 11) 
   (value sQ 12) (value sK 13))

(define (successor-facts)
  (successor 1 0) 
  (successor 2 1) 
  (successor 3 2) 
  (successor 4 3) 
  (successor 5 4) 
  (successor 6 5) 
  (successor 7 6) 
  (successor 8 7) 
  (successor 9 8) 
  (successor 10 9) 
  (successor 11 10) 
  (successor 12 11) 
  (successor 13 12))

(define (suit-facts)
   (suit c0 c) (suit cA c) (suit c2 c) (suit c3 c) 
   (suit c4 c) (suit c5 c) (suit c6 c) (suit c7 c) 
   (suit c8 c) (suit c9 c) (suit c10 c) (suit cJ c) 
   (suit cQ c) (suit cK c)
   (suit d0 d) (suit dA d) (suit d2 d) (suit d3 d) 
   (suit d4 d) (suit d5 d) (suit d6 d) (suit d7 d) 
   (suit d8 d) (suit d9 d) (suit d10 d) (suit dJ d) 
   (suit dQ d) (suit dK d)
   (suit h0 h) (suit hA h) (suit h2 h) (suit h3 h) 
   (suit h4 h) (suit h5 h) (suit h6 h) (suit h7 h) 
   (suit h8 h) (suit h9 h) (suit h10 h) (suit hJ h) 
   (suit hQ h) (suit hK h)
   (suit s0 s) (suit sA s) (suit s2 s) (suit s3 s) 
   (suit s4 s) (suit s5 s) (suit s6 s) (suit s7 s) 
   (suit s8 s) (suit s9 s) (suit s10 s) (suit sJ s) 
   (suit sQ s) (suit sK s))

(define (next-in-suit-facts)
   (next-in-suit c0 cA) (next-in-suit cA c2) 
   (next-in-suit c2 c3) (next-in-suit c3 c4) 
   (next-in-suit c4 c5) (next-in-suit c5 c6) 
   (next-in-suit c6 c7) (next-in-suit c7 c8) 
   (next-in-suit c8 c9) (next-in-suit c9 c10) 
   (next-in-suit c10 cJ) (next-in-suit cJ cQ) 
   (next-in-suit cQ cK)
   (next-in-suit d0 dA) (next-in-suit dA d2) 
   (next-in-suit d2 d3) (next-in-suit d3 d4) 
   (next-in-suit d4 d5) (next-in-suit d5 d6) 
   (next-in-suit d6 d7) (next-in-suit d7 d8) 
   (next-in-suit d8 d9) (next-in-suit d9 d10) 
   (next-in-suit d10 dJ) (next-in-suit dJ dQ) 
   (next-in-suit dQ dK)
   (next-in-suit h0 hA) (next-in-suit hA h2) 
   (next-in-suit h2 h3) (next-in-suit h3 h4) 
   (next-in-suit h4 h5) (next-in-suit h5 h6) 
   (next-in-suit h6 h7) (next-in-suit h7 h8) 
   (next-in-suit h8 h9) (next-in-suit h9 h10) 
   (next-in-suit h10 hJ) (next-in-suit hJ hQ) 
   (next-in-suit hQ hK)
   (next-in-suit s0 sA) (next-in-suit sA s2) 
   (next-in-suit s2 s3) (next-in-suit s3 s4) 
   (next-in-suit s4 s5) (next-in-suit s5 s6) 
   (next-in-suit s6 s7) (next-in-suit s7 s8) 
   (next-in-suit s8 s9) (next-in-suit s9 s10) 
   (next-in-suit s10 sJ) (next-in-suit sJ sQ) 
   (next-in-suit sQ sK))

(define (canstack-facts)
   (canstack cA h2) (canstack cA d2)
   (canstack dA s2) (canstack dA c2)
   (canstack hA s2) (canstack hA c2)
   (canstack sA h2) (canstack sA d2)
   (canstack c2 h3) (canstack c2 d3)
   (canstack d2 s3) (canstack d2 c3)
   (canstack h2 s3) (canstack h2 c3)
   (canstack s2 h3) (canstack s2 d3)
   (canstack c3 h4) (canstack c3 d4)
   (canstack d3 s4) (canstack d3 c4)
   (canstack h3 s4) (canstack h3 c4)
   (canstack s3 h4) (canstack s3 d4)
   (canstack c4 h5) (canstack c4 d5)
   (canstack d4 s5) (canstack d4 c5)
   (canstack h4 s5) (canstack h4 c5)
   (canstack s4 h5) (canstack s4 d5)
   (canstack c5 h6) (canstack c5 d6)
   (canstack d5 s6) (canstack d5 c6)
   (canstack h5 s6) (canstack h5 c6)
   (canstack s5 h6) (canstack s5 d6)
   (canstack c6 h7) (canstack c6 d7)
   (canstack d6 s7) (canstack d6 c7)
   (canstack h6 s7) (canstack h6 c7)
   (canstack s6 h7) (canstack s6 d7)
   (canstack c7 h8) (canstack c7 d8)
   (canstack d7 s8) (canstack d7 c8)
   (canstack h7 s8) (canstack h7 c8)
   (canstack s7 h8) (canstack s7 d8)
   (canstack c8 h9) (canstack c8 d9)
   (canstack d8 s9) (canstack d8 c9)
   (canstack h8 s9) (canstack h8 c9)
   (canstack s8 h9) (canstack s8 d9)
   (canstack c9 h10) (canstack c9 d10)
   (canstack d9 s10) (canstack d9 c10)
   (canstack h9 s10) (canstack h9 c10)
   (canstack s9 h10) (canstack s9 d10)
   (canstack c10 hJ) (canstack c10 dJ)
   (canstack d10 sJ) (canstack d10 cJ)
   (canstack h10 sJ) (canstack h10 cJ)
   (canstack s10 hJ) (canstack s10 dJ)
   (canstack cJ hQ) (canstack cJ dQ)
   (canstack dJ sQ) (canstack dJ cQ)
   (canstack hJ sQ) (canstack hJ cQ)
   (canstack sJ hQ) (canstack sJ dQ)
   (canstack cQ hK) (canstack cQ dK)
   (canstack dQ sK) (canstack dQ cK)
   (canstack hQ sK) (canstack hQ cK)
   (canstack sQ hK) (canstack sQ dK))

(define (home-facts)
   (home c0) (home d0) (home h0) (home s0))

(define (space-facts)
   (cellspace 4) (colspace 0))

(set-initial-facts
 (value-facts)
 (suit-facts)
 (next-in-suit-facts)
 (canstack-facts)
 (home-facts)
 (successor-facts)
 (= (number-home) 0)
 )

(set-initialization-sequence
 (set-computed-colspace)
 (add (cellspace 4)))

(def-defined-predicate (set-computed-colspace)
  (local-vars ?sp)
  (and
   (:= ?sp 0)
   (forall (?c) (bottomcol ?c)
	   (:= ?sp (+ ?sp 1)))
   (add (colspace (- 8 ?sp)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 6. Operators. These can be  compacted with functions 
;;; and simple arithmetic numbers! In a better possible world we would
;;; run two separate versions of this domain adl and strips, too bad
;;; we don't live there....
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Move card between columns. Two versions dependent on whether or
;;; not we generate a new stack.

(def-strips-operator (move ?card ?oldcard ?newcard)
  (pre
   (clear ?card) 
   (clear ?newcard)
   (canstack ?card ?newcard)
   (on ?card ?oldcard))
  (add
   (on ?card ?newcard)
   (clear ?oldcard))
  (del
   (on ?card ?oldcard)
   (clear ?newcard))
  (priority 1))

(def-strips-operator (move-b ?card ?newcard ?cols ?ncols)
  (pre
   (clear ?card) 
   (bottomcol ?card)
   (clear ?newcard)
   (canstack ?card ?newcard)
   (colspace ?cols)
   (successor ?ncols ?cols))
  (add
   (on ?card ?newcard)
   (colspace ?ncols))
  (del
   (bottomcol ?card)
   (clear ?newcard)
   (colspace ?cols))
  (priority 1))

;; Send a card to a freecell. Two versions dependent on whether or not
;; we generate a new stack.

(def-strips-operator (sendtofree ?card ?oldcard ?cells ?ncells)
  (pre
   (clear ?card) 
   (on ?card ?oldcard)
   (cellspace ?cells)
   (successor ?cells ?ncells))
  (add
   (incell ?card) 
   (clear ?oldcard)
   (cellspace ?ncells))
  (del
   (on ?card ?oldcard)
   (clear ?card)
   (cellspace ?cells))
  (priority 1))

(def-strips-operator (sendtofree-b ?card ?cells ?ncells ?cols ?ncols)
  (pre
   (clear ?card) 
   (bottomcol ?card)
   (cellspace ?cells)
   (successor ?cells ?ncells)
   (colspace ?cols)
   (successor ?ncols ?cols))
  (add
   (incell ?card)
   (colspace ?ncols)
   (cellspace ?ncells))
  (del
   (bottomcol ?card)
   (clear ?card)
   (colspace ?cols)
   (cellspace ?cells))
  (priority 1))

;; Send a card a new column

(def-strips-operator (sendtonewcol ?card ?oldcard ?cols ?ncols)
  (pre
   (clear ?card)
   (colspace ?cols)
   (successor ?cols ?ncols)
   (on ?card ?oldcard))
  (add
   (bottomcol ?card) 
   (clear ?oldcard)
   (colspace ?ncols))
  (del
   (on ?card ?oldcard)
   (colspace ?cols))
  (priority 1))

;;Send a card home

(def-strips-operator (sendtohome ?card ?oldcard ?suit ?vcard ?homecard ?vhomecard)
  (pre
   (clear ?card) 
   (on ?card ?oldcard)
   (home ?homecard)
   (suit ?card ?suit)
   (suit ?homecard ?suit)
   (value ?card ?vcard)
   (value ?homecard ?vhomecard)
   (successor ?vcard ?vhomecard))
  (add
   (home ?card)
   (clear ?oldcard)
   (= (number-home) (+ 1 (number-home)))
   )
  (del
   (on ?card ?oldcard)
   (home ?homecard)
   (clear ?card))
  (priority 100))


(def-strips-operator (sendtohome-b ?card ?suit ?vcard ?homecard
				   ?vhomecard ?cols ?ncols)
  (pre
   (clear ?card) 
   (bottomcol ?card)
   (home ?homecard)
   (suit ?card ?suit)
   (suit ?homecard ?suit)
   (value ?card ?vcard)
   (value ?homecard ?vhomecard)
   (successor ?vcard ?vhomecard)
   (colspace ?cols)
   (successor ?ncols ?cols))
  (add
   (home ?card)
   (= (number-home) (+ 1 (number-home)))
   (colspace ?ncols))
  (del
   (home ?homecard)
   (clear ?card)
   (bottomcol ?card)
   (colspace ?cols))
  (priority 100))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Move cards in free cell
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def-strips-operator (homefromfreecell ?card ?suit ?vcard
				       ?homecard ?vhomecard ?cells ?ncells)
    ;;Send a card home from a free cell.
  (pre
   (incell ?card)
   (home ?homecard) 
   (suit ?card ?suit)
   (suit ?homecard ?suit)
   (value ?card ?vcard)
   (value ?homecard ?vhomecard)
   (successor ?vcard ?vhomecard)
   (cellspace ?cells)
   (successor ?ncells ?cells))
  (add
   (home ?card)
   (= (number-home) (+ 1 (number-home)))
   (cellspace ?ncells))
  (del
   (incell ?card)
   (cellspace ?cells)
   (home ?homecard))
  (priority 100))

(def-strips-operator (colfromfreecell ?card ?newcard ?cells ?ncells)
  (pre
   (incell ?card)
   (clear ?newcard)
   (canstack ?card ?newcard)
   (cellspace ?cells)
   (successor ?ncells ?cells))
  (add
   (cellspace ?ncells)
   (clear ?card)
   (on ?card ?newcard))
  (del
   (incell ?card)
   (cellspace ?cells)
   (clear ?newcard))
    (priority 1))

(def-strips-operator (newcolfromfreecell ?card ?cols ?ncols ?cells ?ncells)
  (pre
   (incell ?card)
   (colspace ?cols)
   (cellspace ?cells)
   (successor ?cols ?ncols)
   (successor ?ncells ?cells)
   )
  (add
   (bottomcol ?card) 
   (clear ?card)
   (colspace ?ncols)
   (cellspace ?ncells))
  (del
   (incell ?card)
   (colspace ?cols)
   (cellspace ?cells))
  (priority 1))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;