card-game.clj

;;; DECK
(ns card-game.deck)

(defn create []
  (shuffle [:h2 :h3 :h4 :h5 :h6 :h7 :h8 :h9 :h0 :hj :hq :hk :ha
            :d2 :d3 :d4 :d5 :d6 :d7 :d8 :d9 :d0 :dj :dq :dk :da
            :s2 :s3 :s4 :s5 :s6 :s7 :s8 :s9 :s0 :sj :sq :sk :sa
            :c2 :c3 :c4 :c5 :c6 :c7 :c8 :c9 :c0 :cj :cq :ck :ca])
  )

(defn cards-left? [deck] (not (empty? deck)))

(defn draw-card [deck] { :card (first deck), :deck (rest deck) })


;;; HAND
(ns card-game.hand)

; a hand is a list because we will insert at the front
(defn create [] '())

; accessors that give the suit or number of a given card
(defn suit [card] (-> card name first str keyword))
(defn number [card] (-> card name second str keyword))

; game rules
; 'number-match?' if index 0 and 3 are the same number (eg, both kings or both 2s)
; 'suit-match?' if index 1 and 2 are the same suit (eg, both diamonds)
(defn number-match? [[one two three four & extra]] (= (number one) (number four)))
(defn suit-match? [[one two three four & extra]] (= (suit two) (suit three)))

; removes the 1 and 2 index cards from a hand if they are the same suit
(defn remove-suit-pairs [hand]
  (if (suit-match? hand)
    (let [[one _ _ four & extra] hand]
      (concat [one four] extra))
    hand)
  )
; removes all 4 top cards from a hand if the 0 and 3 index cards are the same number
(defn remove-number-pairs [hand]
  (if (number-match? hand)
    (drop 4 hand)
    hand)
  )

; true if the hand has any cards that can be removed
(defn can-process? [hand]
  (and
    (>= (count hand) 4)
    (or (number-match? hand) (suit-match? hand))
    )
  )

; looks at top 4 cards of a hand and returns
; the hand after applying the removal rules
(defn process [hand]
  (if (not (can-process? hand))
    hand
    (if (number-match? hand)
      (recur (remove-number-pairs hand))
      (recur (remove-suit-pairs hand))
      )
    )
  )


;;; CORE
;;; SHELL
;; runs the game, etc
(ns card-game.core (:gen-class))

(require '[card-game.deck :as deck]
         '[card-game.hand :as hand])

; play a single game starting with a new deck and hand
; and recur-ing down until the deck is empty
(defn play []
  (loop [
    deck (deck/create)
    hand (hand/create)
    ]
    (if (hand/can-process? hand)
      ; if our hand is processable, do so and recur
      (recur deck (hand/process hand))
      ; otherwise we need to see if there are any more cards to draw
      (if (deck/cards-left? deck)
        ; if there are, draw one more card and recur
        (let [{:keys [card deck]} (deck/draw-card deck)]
          (recur deck (conj hand card))
          )
        ; if the deck is empty, the game is over
        ; we won if our hand is empty
        (empty? hand)
        )
      )
    )
  )

; give a function which will play group-size games in a row
; and return { :played GAMES_PLAYED, :won GAMES_WON }
(defn play-many [group-size]
  (fn []
    (loop [
      games-left group-size
      games-won  0
      ]
      (if (> games-left 0)
        (if-let [result (play)]
          (recur (dec games-left) (inc games-won))
          (recur (dec games-left) games-won))
        { :played group-size,
          :won games-won }
        )
      )
    )
  )

; print the results of all games played (win percentage/etc)
(defn print-results [{ played :played, won :won }]
  (let [percentage (* 100.0 (/ won played))]
    (println "Played" played "games, won" won "of them "
             (format "(%.2f%%)" percentage))
    )
  )

(defn -main [& [group-count-str group-size-str]]
  (let [
    ; pull out command line args and integerify
    group-size  (Integer/parseInt (or group-size-str "1000"))
    group-count (Integer/parseInt group-count-str)

    ; run-games kicks off an agent to run the specified number of games
    run-games   (fn [_] (future-call (play-many group-size)))

    ; results is just calling run-games group-count times
    ; gives an array of 'future objects' that can be deref'd for their value
    results     (map run-games (range group-count))
    ]
    (println "Playing" (* group-count group-size) "games...")

    ; print the results of deref'ing all the results and merging
    ; the results hashes together (eg { :played TOTAL_PLAYED, :won TOTAL_WON })
    (print-results (apply merge-with + (map deref results)))

    ; spin down all the threads and whatnot
    ; used to run the games asyncronously
    (shutdown-agents)
    )
  )

'Card Game' in Clojure

I don't know what this card game is called. I often use it when fiddling with a new language. The rules are:

• use a full standard deck
• if you ever have less than 4 cards, draw cards until you have at least 4
• look at the first (newest) 4 cards in your hand
  • if the two cards on the outside have the same value (king, 2, 6, etc) -> remove all 4
  • if the two cards on the inside have the same suit -> remove the 2 middle cards
• if the deck is empty and you have 0 cards in your hand, you win

When you play it by hand you effectively never win, so I have written several of these for various languages (Python, Ruby, JavaScript, Erlang, Go, to name a few) and have pretty much settled on an approximate 0.2% chance of winning.

This is my 1st Clojure program ever, slightly cleaned up. It uses a lot of loop/recur where it probably should not. It uses future-call where it should probably explicitly use agents somehow. It has no docstrings and instead has just comments (this is because the copious comments helped me internalize what I was doing).

I don't consider this as purposely silly as fizzbuzz :)

On my local I split this into one namespace per file, but then the naming of the gist is weird (core.clj, etc) and you can't name the top level in any way or use subdirs...

Want to run it?

brew install leiningen
lein new app card-game && cd card-game
export GAME_URL="https://gist.github.com/rfunduk/5526582/raw/42ca93c8b3b44b6980c4045a81caadcb38d1b59a/card-game.clj"
curl $GAME_URL -o src/card-game/core.clj
# lein run GROUP_COUNT [GROUP_SIZE default 1000]
lein run 1 # run 1000 games
lein run 1 1 # run 1 game
lein run 1000 2000 # run 2 million games