Poker kata

core.clj

(ns poker-kata.core)

;; Functions to evaluate (5 card) poker hands, based on the code kata
;; at http://codingdojo.org/cgi-bin/wiki.pl?KataPokerHands

;; A card is represented by a vector with a numeric rank and a suit.
;; example cards:
;;  5 of diamonds  [5 :diamonds]
;;  ace of spades  [14 :spades]

(def suits [:clubs :diamonds :hearts :spades])

;; define the ordering of different kinds of hands
(def poker-hands-order (zipmap [:high-card :pair :two-pairs :three-of-a-kind :straight :flush :full-house :four-of-a-kind :straight-flush] (iterate inc 0)))

(def to-suit {\C :clubs \D :diamonds \H :hearts \S :spades})
(def to-rank {\2 2 \3 3 \4 4 \5 5 \6 6 \7 7 \8 8 \9 9 \T 10 \J 11 \Q 12 \K 13 \A 14})
(def rank-to-str {2 2, 3 3, 4 4, 5 5, 6 6, 7 7, 8 8, 9 9, 10 10, 
  11 "Jack", 12 "Queen", 13 "King", 14 "Ace"})

(defn card?
  "Try to determine if the given object looks like a card"
  [x]
  (and
    (sequential? x)
    (integer? (first x))
    (some #(= % (second x)) suits)))

(defn rank
  "get rank for a card or sequence of cards"
  [cards]
  (cond
    (card? cards) (first cards)
    (sequential? cards) (map first cards)))

(defn suit
  "get suit for a card or sequence of cards"
  [cards]
  (cond
    (card? cards) (second cards)
    (sequential? cards) (map second cards)))

(defn card-to-str
  [card]
  (str (rank-to-str (rank card)) " of " (name (suit card))))

(defn sort-cards
  "Sort by suit first, then rank within suit"
  [cards]
  (sort-by #(vec (reverse %)) cards))

(defn parse-card
  "Parse a two character string into a card. The first character represents the
   rank (2-9,T,J,Q,K,A) and the second character the suit (C, D, H, S)"
  [card-string]
  [(to-rank (first card-string))
   (to-suit (second card-string))])

(defn parse-hand
  "Parse a handful of cards from a whitespace delimited string to a list of cards"
  [hand-string]
  (vec (sort-cards (map parse-card (clojure.string/split hand-string #"\s+")))))

(defn deal
  "Deal n cards off the deck"
  [deck n]
  (vector (take n deck) (drop n deck)))

(defn new-deck
  "Return a new 52 card deck"
  []
  (for [r (range 2 15)
        s suits]
    (vector r s)))

(defn highest-rank
  "finds card with highest rank"
  [cards]
  (apply max (rank cards)))

(defn- consecutive-sorted?
  [a]
  (if (= 1 (count a))
    true
    (and
      (= (second a) (inc (first a)))
      (consecutive-sorted? (rest a)))))

(defn consecutive?
  "Determines whether the input is a sequence of consecutive items (eg. [4,5,6,7]).
   To avoid resorting input, include :sorted as a parameter."
  [a & more]
  (if (= 1 (count a))
    true
    (if (some #{:sorted} more)
      (consecutive-sorted? a)
      (consecutive-sorted? (sort a)))))

(defn runs
  "Organize cards into runs of the same rank (2-of-a-kind, 2-pairs, full-house, etc.).
   Returns"
  [cards]
  (reverse (sort-by #(vector (count %) (rank (first %)))
    (partition-by rank (sort cards)))))

(defn condense-runs
  "Given some runs, extract the rank of each run"
  [runs]
  (map #(rank (first %)) runs))

(defn flush? [hand]
  (apply = (suit hand)))

(defn straight? [hand]
  (consecutive? (rank hand)))

(defn straight-flush? [hand]
  (and (straight? hand) (flush? hand)))

(defn four-of-a-kind?
  [hand]
  (= [4 1] (map count (runs hand))))

(defn full-house?
  [hand]
  (= [3 2] (map count (runs hand))))

(defn three-of-a-kind?
  [hand]
  (= [3 1 1] (map count (runs hand))))

(defn pair?
  [hand]
  (= [2 1 1 1] (map count (runs hand))))

(defn two-pairs?
  [hand]
  (= [2 2 1] (map count (runs hand))))

(defn classify-hand
  "Given a 5-card hand, return what kind of hand it is (full-house, pair, etc.)"
  [hand]
  (cond 
    (straight-flush? hand) :straight-flush
    (four-of-a-kind? hand) :four-of-a-kind
    (full-house? hand) :full-house
    (flush? hand) :flush
    (straight? hand) :straight
    (three-of-a-kind? hand) :three-of-a-kind
    (two-pairs? hand) :two-pairs
    (pair? hand) :pair
    :else :high-card))

(defn- compare-by-rank
  "Compare hands by highest ranking card, resolving ties by second highest ranking
  card, etc."
  [hand1 hand2]
  (compare (vec (reverse (sort (rank hand1)))) (vec (reverse (sort (rank hand2))))))

(defn- compare-runs-by-rank
  "Compare hands that depend on runs (n-of-kind, full-house, 2-pairs). Note,
  this method only compares two hands of the *same* kind."
  [hand1 hand2]
  (compare (vec (condense-runs (runs hand1))) (vec (condense-runs (runs hand2)))))

(defn compare-hands
  "compare two poker hands, returning a negative value, 0 or a positive value"
  [hand1 hand2]
  (let [class1 (classify-hand hand1)
        class2 (classify-hand hand2)]
    (cond
      (not= class1 class2)
        (- (poker-hands-order class1) (poker-hands-order class2))
      (#{:pair :two-pairs :three-of-a-kind :full-house :four-of-a-kind} class1)
        (compare-runs-by-rank hand1 hand2)
      :else
        (compare-by-rank hand1 hand2))))

(defn count-hands
  "Generate n random poker hands, classify them and total up the counts
   for each type of hand."
  [n]
  (reduce #(assoc %1 %2 (inc (%1 %2 0)))
    {}
    (for [x (range n)]
      (classify-hand
        (take 5 (shuffle (new-deck)))))))

(defn -main
  "Let's play some poker."
  [& args]
  (println (str (first args)) "poker hands coming up!")
  (count-hands (read-string (first args))))

core_test.clj

(ns poker-kata.core-test
  (:use clojure.test
        poker-kata.core))

(def hand (parse-hand "KH QS 2C 8D 9S"))
(def equally-bad-hand (parse-hand "KS QH 8S 2D 9H"))
(def better-hand (parse-hand "KS QH 3S 8D 9H"))
(def hand-s (parse-hand "2C 3H 4S 5D 6C"))
(def hand-f (parse-hand "4H KH 6H JH 8H"))
(def hand-sf (parse-hand "4H 5H 6H 7H 8H"))
(def hand-4 (parse-hand "TS TH TC TD 7S"))
(def hand-fh (parse-hand "AS AH AC KD KS"))
(def hand-3 (parse-hand "TS TH TC AD 7S"))
(def hand-2p (parse-hand "TS TH AC AD 7S"))
(def hand-2 (parse-hand "TS 9H AC AD 7S"))

(deftest test-recognition-of-cards
  (testing "Testing detection of cards"
    (is (not (card? nil)))
    (is (not (card? "foo")))
    (is (not (card? [])))
    (is (not (card? [3 :foo])))
    (is (not (card? [\z :hearts])))
    (is (card? [10 :hearts]))
    (is (card? [2 :spades])) ))

(deftest test-rank-and-suit
  (testing "Testing extraction of rank and suit from cards"
    (is (= (rank [5 :hearts]) 5))
    (is (= (suit [5 :hearts]) :hearts)) ))

(deftest test-sort-cards
  (testing "Testing sort cards, which orders by suit then rank"
    (is (=
          (sort-cards [[10 :clubs] [9 :clubs] [11 :spades] [12 :hearts] [13 :diamonds]])
          [[9 :clubs] [10 :clubs] [13 :diamonds] [12 :hearts] [11 :spades]]))))

(deftest test-parse-card
  (testing "Testing parsing card"
    (is (= (parse-card "TS") [10 :spades]))
    (is (= (parse-card "5C") [5 :clubs]))
    (is (= (parse-card "2D") [2 :diamonds]))
    (is (= (parse-card "AH") [14 :hearts])) ))

(deftest test-parse-hand
  (testing "Testing parse hand"
    (is (=
          (parse-hand "9C TC JS QH KD")
          [[9 :clubs] [10 :clubs] [13 :diamonds] [12 :hearts] [11 :spades]]))))

(deftest test-consecutive
  (testing "detection of consecutively ordered sequences"
    (is (consecutive? [5 6 7 8 9 10]))
    (is (not (consecutive? [5 6 7 9 10]))) ))

(deftest test-detecting-runs
  (testing "Test detection of runs of like ranks"
    (is (= 
      (runs (parse-hand "3H AS 3C AD 3S"))
      '(([3 :clubs] [3 :hearts] [3 :spades]) ([14 :diamonds] [14 :spades])))) ))

(deftest test-hand-classification
  (testing "Test hand classification predicates"
    (is (not (flush? hand)))
    (is (flush? hand-f))
    (is (flush? hand-sf))
    (is (not (straight? hand)))
    (is (straight? hand-s))
    (is (not (straight-flush? hand-s)))
    (is (not (straight-flush? hand-f)))
    (is (straight-flush? hand-sf))
    (is (not (pair? hand)))
    (is (pair? hand-2))
    (is (not (two-pairs? hand-2)))
    (is (two-pairs? hand-2p))
    (is (not (three-of-a-kind? hand-2p)))
    (is (not (three-of-a-kind? hand-2)))
    (is (three-of-a-kind? hand-3))
    (is (not (full-house? hand-3)))
    (is (full-house? hand-fh))
    (is (not (four-of-a-kind? hand-3)))
    (is (four-of-a-kind? hand-4))
  ))

(deftest test-compare-hands
  (testing "Test comparison of poker hands"

    ;; compare different classes of hands
    (is (pos? (compare-hands hand-sf hand-f)))
    (is (pos? (compare-hands hand-sf hand-s)))
    (is (pos? (compare-hands hand-s hand-2p)))
    (is (pos? (compare-hands hand-fh hand)))
    (is (neg? (compare-hands hand-2p hand-fh)))
    (is (neg? (compare-hands hand-3 hand-4)))
    (is (neg? (compare-hands hand-2 hand-3)))
    (is (neg? (compare-hands hand hand-2)))

    ;; compare 2 full houses
    (is (pos? (compare-hands 
      (parse-hand "TH TS TC JS JD")
      (parse-hand "9C 9S 9H QH QD"))))
    
    ;; compare 2 hands containing 2 pairs, different in lesser pair
    (is (pos? (compare-hands 
      (parse-hand "TH TS JS JD 3C")
      (parse-hand "9C 9S JH JC 7D"))))

    ;; compare 2 hands containing 2 pairs, different in last card
    (is (pos? (compare-hands 
      (parse-hand "9H 9D JS JD 4C")
      (parse-hand "9C 9S JH JC 3D"))))

    (is (neg? (compare-hands hand better-hand)))
    
    ;; compare identical hands
    (is (zero? (compare-hands hand hand)))
    (is (zero? (compare-hands hand equally-bad-hand)))
    (is (zero? (compare-hands hand-fh hand-fh)))
    (is (zero? (compare-hands hand-s hand-s)))
  ))