dealing cards in Clojure

Question

I am trying to write a Spider Solitaire player as an exercise in learning Clojure. I am trying to figure out how to deal the cards.

I have created (with the help of stackoverflow), a shuffled sequence of 104 cards from two standard decks. Each card is represented as a

(defstruct card :rank :suit :face-up)

The tableau for Spider will be represented as follows:

(defstruct tableau :stacks :complete)

where :stacks is a vector of card vectors, 4 of which contain 5 cards face down and 1 card face up, and 6 of which contain 4 cards face down and 1 card face up, for a total of 54 cards, and :complete is an (initially) empty vector of completed sets of ace-king (represented as, for example, king-hearts, for printing purposes). The remainder of the undealt deck should be saved in a ref

(def deck (ref seq))

During the game, a tableau may contain, for example:

(struct-map tableau
  :stacks [[AH 2C KS ...]
           [6D QH JS ...]
           ...
           ]
  :complete [KC KS])

where "AH" is a card containing {:rank :ace :suit :hearts :face-up false}, etc.

How can I write a function to deal the stacks and then save the remainder in the ref?

Answer 1

You could write a function to take chunks vectors of size items each from a given sequence and another one to drop those chunks from the front:

;; note the built-in assumption that s contains enough items;
;; if it doesn't, one chunk less then requested will be produced
(defn take-chunks [chunks size s]
  (map vec (partition size (take (* chunks size) s))))

;; as above, no effort is made to handle short sequences in some special way;
;; for a short input sequence, an empty output sequence will be returned
(defn drop-chunks [chunks size s]
  (drop (* chunks size) s))

Then maybe add a function to do both (modelled after split-at and split-with):

(defn split-chunks [chunks size s]
  [(take-chunks chunks size s)
   (drop-chunks chunks size s)])

Assuming that each card is initially {:face-up false}, you can use the following function to turn the last card on a stack:

(defn turn-last-card [stack]
  (update-in stack [(dec (count stack)) :face-up] not))

Then a function to deal out the initial stacks / chunks from the the given deck:

(defn deal-initial-stacks [deck]
  (dosync
    (let [[short-stacks remaining] (split-chunks 6 5 deck)
          [long-stacks remaining] (split-chunks 4 6 remaining)]
      [remaining
       (vec (map turn-last-card
                 (concat short-stacks long-stacks)))])))

The return value is a doubleton vector whose first element is the remainder of the deck and whose second element is a vector of the initial stacks.

Then use this in a transaction to take the Ref into account:

(dosync (let [[new-deck stacks] (deal-initial-stacks @deck-ref)]
          (ref-set deck-ref new-deck)
          stacks))

Better yet, keep the whole state of the game in a single Ref or Atom and switch from ref-set to alter / swap! (I'll use a Ref for this example, omit the dosync and switch alter to swap! to use an atom instead):

;; the empty vector is for the stacks
(def game-state-ref (ref [(get-initial-deck) []]))

;; deal-initial-stacks only takes a deck as an argument,
;; but the fn passed to alter will receive a vector of [deck stacks];
;; the (% 0) bit extracts the first item of the vector,
;; that is, the deck; you could instead change the arguments
;; vector of deal-initial-stacks to [[deck _]] and pass the
;; modified deal-initial-stacks to alter without wrapping in a #(...)
(dosync (alter game-state-ref #(deal-initial-stacks (% 0))))

Disclaimer: None of this has received the slightest amount of testing attention (though I think it should work fine, modulo any silly typos I might have missed). It's your exercise, though, so I think leaving the testing / polishing part to you is fine. :-)

Answer 2

Here is a solution that I came up with after studying the answer above. Note that I am still refining it and welcome suggestions for improvements, particularly the use of more idiomatic Clojure. Also note that these functions are defined in several separate files and do not necessarily appear in the order shown (if that makes a difference).

(def suits [:clubs :diamonds :hearts :spades])
(def suit-names
  {:clubs "C" :diamonds "D"
   :hearts "H" :spades "S"})

(def ranks
  (reduce into (replicate 2
    [:ace :two :three :four :five :six :seven :eight :nine :ten :jack :queen :king])))
(def rank-names
  {:ace "A" :two "2"
   :three "3" :four "4"
   :five "5" :six "6"
   :seven "7" :eight "8"
   :nine "9" :ten "T"
   :jack "J" :queen "Q"
   :king "K"})

(defn card-name
  [card show-face-down]
  (let
    [rank (rank-names (:rank card))
     suit (suit-names (:suit card))
     face-down (:face-down card)]
    (if
      face-down
      (if
        show-face-down
        (.toLowerCase (str rank suit))
        "XX")
      (str rank suit))))

(defn suit-seq
  "Return 4 suits:
  if number-of-suits == 1: :clubs :clubs :clubs :clubs
  if number-of-suits == 2: :clubs :diamonds :clubs :diamonds
  if number-of-suits == 4: :clubs :diamonds :hearts :spades."
  [number-of-suits]
  (take 4 (cycle (take number-of-suits suits))))

(defstruct card :rank :suit :face-down)

(defn unshuffled-deck
  "Create an unshuffled deck containing all cards from the number of suits specified."
  [number-of-suits]
  (for
    [rank ranks suit (suit-seq number-of-suits)]
    (struct card rank suit true)))

(defn shuffled-deck
  "Create a shuffled deck containing all cards from the number of suits specified."
  [number-of-suits]
  (shuffle (unshuffled-deck number-of-suits)))

(defn deal-one-stack
  "Deals a stack of n cards and returns a vector containing the new stack and the rest of the deck."
  [n deck]
  (loop
    [stack []
     current n
     rest-deck deck]
    (if (<= current 0)
      (vector
        (vec
          (reverse
            (conj
              (rest stack)
              (let
                [{rank :rank suit :suit} (first stack)]
                (struct card rank suit false)))))
        rest-deck)
      (recur (conj stack (first rest-deck)) (dec current) (rest rest-deck)))))

(def current-deck (ref (shuffled-deck 4)))

(defn deal-initial-tableau
  "Deals the initial tableau and returns it. Sets the @deck to the remainder of the deck after dealing."
  []
  (dosync
    (loop
      [stacks []
       current 10
       rest-deck @current-deck]
      (if (<= current 0)
        (let [t (struct tableau (reverse stacks) [])
              r rest-deck]
          (ref-set current-deck r)
          t)
        (let
          [n (if (<= current 4) 6 5)
           [s r] (deal-one-stack n rest-deck)]
          (recur (vec (conj stacks s)) (dec current) r))))))

(defstruct tableau :stacks :complete)

(defn pretty-print-tableau
  [tableau show-face-down]
  (let
    [{stacks :stacks complete :complete} tableau]
    (apply str
      (for
        [row (range 0 6)]
        (str
          (apply str
            (for
              [stack stacks]
              (let
                [card (nth stack row nil)]
                (str
                  (if
                    (nil? card)
                    "  "
                    (card-name card show-face-down)) " "))))
          \newline)))))