🎉 Exercism Research is now launched. Help Exercism, help science and have some fun at research.exercism.io 🎉
Avatar of joostkremers

joostkremers's solution

to Poker in the Clojure Track

Published at Mar 31 2020 · 0 comments
Instructions
Test suite
Solution

Pick the best hand(s) from a list of poker hands.

See wikipedia for an overview of poker hands.

Source

Inspired by the training course from Udacity. https://www.udacity.com/course/viewer#!/c-cs212/

Submitting Incomplete Solutions

It's possible to submit an incomplete solution so you can see how others have completed the exercise.

poker_test.clj

(ns poker-test
  (:require [clojure.test :refer [deftest is]]
            [poker :refer [best-hands]]))

(defn f [xs ys] (= (sort (best-hands xs)) (sort ys)))

(deftest single-hand-always-wins
  (is (f ["4S 5S 7H 8D JC"] ["4S 5S 7H 8D JC"])))

(deftest highest-card-out-of-all-hands-wins
  (is (f ["4D 5S 6S 8D 3C"
          "2S 4C 7S 9H 10H"
          "3S 4S 5D 6H JH"]
         ["3S 4S 5D 6H JH"])))

(deftest a-tie-has-multiple-winners
  (is (f ["4D 5S 6S 8D 3C"
          "2S 4C 7S 9H 10H"
          "3S 4S 5D 6H JH"
          "3H 4H 5C 6C JD"]
         ["3S 4S 5D 6H JH"
          "3H 4H 5C 6C JD"])))

(deftest multiple-hands-with-the-same-high-cards-tie-compares-next-highest-ranked-down-to-last-card
  (is (f ["3S 5H 6S 8D 7H"
          "2S 5D 6D 8C 7S"]
         ["3S 5H 6S 8D 7H"])))

(deftest one-pair-beats-high-card
  (is (f ["4S 5H 6C 8D KH"
          "2S 4H 6S 4D JH"]
         ["2S 4H 6S 4D JH"])))

(deftest highest-pair-wins
  (is (f ["4S 2H 6S 2D JH"
          "2S 4H 6C 4D JD"]
         ["2S 4H 6C 4D JD"])))

(deftest two-pairs-beats-one-pair
  (is (f ["2S 8H 6S 8D JH"
          "4S 5H 4C 8C 5C"]
         ["4S 5H 4C 8C 5C"])))

(deftest both-hands-have-two-pairs-highest-ranked-pair-wins
  (is (f ["2S 8H 2D 8D 3H"
          "4S 5H 4C 8S 5D"]
         ["2S 8H 2D 8D 3H"])))

(deftest both-hands-have-two-pairs-with-the-same-highest-ranked-pair-tie-goes-to-low-pair
  (is (f ["2S QS 2C QD JH"
          "JD QH JS 8D QC"]
         ["JD QH JS 8D QC"])))

(deftest both-hands-have-two-identically-ranked-pairs-tie-goes-to-remaining-card-kicker
  (is (f ["JD QH JS 8D QC"
          "JS QS JC 2D QD"]
         ["JD QH JS 8D QC"])))

(deftest three-of-a-kind-beats-two-pair
  (is (f ["2S 8H 2H 8D JH"
          "4S 5H 4C 8S 4H"]
         ["4S 5H 4C 8S 4H"])))

(deftest both-hands-have-three-of-a-kind-tie-goes-to-highest-ranked-triplet
  (is (f ["2S 2H 2C 8D JH"
          "4S AH AS 8C AD"]
         ["4S AH AS 8C AD"])))

(deftest with-multiple-decks-two-players-can-have-same-three-of-a-kind-ties-go-to-highest-remaining-cards
  (is (f ["4S AH AS 7C AD"
          "4S AH AS 8C AD"]
         ["4S AH AS 8C AD"])))

(deftest a-straight-beats-three-of-a-kind
  (is (f ["4S 5H 4C 8D 4H"
          "3S 4D 2S 6D 5C"]
         ["3S 4D 2S 6D 5C"])))

(deftest aces-can-end-a-straight-10-J-Q-K-A
  (is (f ["4S 5H 4C 8D 4H"
          "10D JH QS KD AC"]
         ["10D JH QS KD AC"])))

(deftest aces-can-start-a-straight-A-2-3-4-5
  (is (f ["4S 5H 4C 8D 4H"
          "4D AH 3S 2D 5C"]
         ["4D AH 3S 2D 5C"])))

(deftest both-hands-with-a-straight-tie-goes-to-highest-ranked-card
  (is (f ["4S 6C 7S 8D 5H"
          "5S 7H 8S 9D 6H"]
         ["5S 7H 8S 9D 6H"])))

(deftest even-though-an-ace-is-usually-high-a-5-high-straight-is-the-lowest-scoring-straight
  (is (f ["2H 3C 4D 5D 6H"
          "4S AH 3S 2D 5H"]
         ["2H 3C 4D 5D 6H"])))

(deftest flush-beats-a-straight
  (is (f ["4C 6H 7D 8D 5H"
          "2S 4S 5S 6S 7S"]
         ["2S 4S 5S 6S 7S"])))

(deftest both-hands-have-a-flush-tie-goes-to-high-card-down-to-the-last-one-if-necessary
  (is (f ["4H 7H 8H 9H 6H"
          "2S 4S 5S 6S 7S"]
         ["4H 7H 8H 9H 6H"])))

(deftest full-house-beats-a-flush
  (is (f ["3H 6H 7H 8H 5H"
          "4S 5H 4C 5D 4H"]
         ["4S 5H 4C 5D 4H"])))

(deftest both-hands-have-a-full-house-tie-goes-to-highest-ranked-triplet
  (is (f ["4H 4S 4D 9S 9D"
          "5H 5S 5D 8S 8D"]
         ["5H 5S 5D 8S 8D"])))

(deftest with-multiple-decks-both-hands-have-a-full-house-with-the-same-triplet-tie-goes-to-the-pair
  (is (f ["5H 5S 5D 9S 9D"
          "5H 5S 5D 8S 8D"]
         ["5H 5S 5D 9S 9D"])))

(deftest four-of-a-kind-beats-a-full-house
  (is (f ["4S 5H 4D 5D 4H"
          "3S 3H 2S 3D 3C"]
         ["3S 3H 2S 3D 3C"])))

(deftest both-hands-have-four-of-a-kind-tie-goes-to-high-quad
  (is (f ["2S 2H 2C 8D 2D"
          "4S 5H 5S 5D 5C"]
         ["4S 5H 5S 5D 5C"])))

(deftest with-multiple-decks-both-hands-with-identical-four-of-a-kind-tie-determined-by-kicker
  (is (f ["3S 3H 2S 3D 3C"
          "3S 3H 4S 3D 3C"]
         ["3S 3H 4S 3D 3C"])))

(deftest straight-flush-beats-four-of-a-kind
  (is (f ["4S 5H 5S 5D 5C"
          "7S 8S 9S 6S 10S"]
         ["7S 8S 9S 6S 10S"])))

(deftest both-hands-have-straight-flush-tie-goes-to-highest-ranked-card
  (is (f ["4H 6H 7H 8H 5H"
          "5S 7S 8S 9S 6S"]
         ["5S 7S 8S 9S 6S"])))
(ns poker
  [:require [clojure.string :as string]])

(def card-regexp #"(\A(?:[2-9AJQK]|10))([HDCS])\Z")

(defn rank [card]
  (nth (re-find card-regexp card) 1))

(defn suit [card]
  (nth (re-find card-regexp card) 2))

(defn rank->int [rank]
  (cond
    (= rank "A") 14
    (= rank "K") 13
    (= rank "Q") 12
    (= rank "J") 11
    :else (Integer/parseInt rank)))

(defn rank> [& args]
  (apply > (map rank->int args)))

(defn compare-ranks [ranks-x ranks-y]
  "Three-way comparator for two sorted lists of ranks.
Return value is 0 if `ranks-x` and `ranks-y` are equal, negative if `ranks-x` is
smaller than `ranks-y`, and positive if `ranks-x` is larger than `ranks-y`. If
the lists are of unequal length, comparison stops when the shortest list is
exhausted. If all ranks up to that point were equal, the two lists are
considered equal."
  (loop [[x & xs] ranks-x
         [y & ys] ranks-y]
    (cond
      (or (nil? x) (nil? y)) 0
      (= x y) (recur xs ys)
      :else (compare (rank->int x) (rank->int y)))))

;; The following functions determine whether a given hand qualifies as a
;; particular poker hand (here called a category). The return value is either
;; `false`/`nil` or a number indicating the strength of the hand, with 9 the
;; strongest, 1 the weakest.

;; Note: these functions do *not* check if the hand also matches a higher-ranked
;; category. The proper way to categorize a hand is by using `categorize-hand`
;; below.

(declare straight? flush?)

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

(defn four-of-a-kind? [hand]
  (if (some #(= 4 (count %)) (vals (:ranks (meta hand))))
    8))

(defn full-house? [hand]
  (if (= 2 (count (:ranks (meta hand))))
    7))

(defn flush? [hand]
  (if (= 1 (count (:suits (meta hand))))
    6))

(defn straight? [hand]
  ;; To test whether a list of ranks is a straight, the list is converted to a
  ;; regex and tested against a sequence of ranks. The additional pattern
  ;; accounts for a 5-high straight, in which A counts as 1.
  (let [ranks-re (re-pattern (apply str (map rank hand)))]
    (if (re-find ranks-re "AKQJ1098765432 A5432")
      5)))

(defn three-of-a-kind? [hand]
  (if (some #(= 3 (count %)) (vals (:ranks (meta hand))))
    4))

(defn two-pair? [hand]
  (if (= 3 (count (:ranks (meta hand))))
    3))

(defn one-pair? [hand]
  (if (some #(= 2 (count %)) (vals (:ranks (meta hand))))
    2))

(defn high-card? [_hand]
  1)

(def categorize-hand (some-fn straight-flush?
                              four-of-a-kind?
                              full-house?
                              flush?
                              straight?
                              three-of-a-kind?
                              two-pair?
                              one-pair?
                              high-card?))

;; Helper functions for comparing hands of the same category (here called
;; secondary comparison). These functions are used to extract the ranks of the
;; relevant card groups.

(defn all-ranks [hand]
  "Return a list of the ranks of all cards in `hand`."
  ;; Since `hand` is sorted, we don't need to sort again.
  (map rank hand))

(defn straight [hand]
  "Return a list of the ranks of a straight.
This is similar to `all-ranks`, except when `hand` is a 5-high straight, in
which case the ace is converted to 1."
  (if (= (apply str (map rank hand)) "A5432")
    ["5" "4" "3" "2" "1"]
    (map rank hand)))

(defn quadruplet [hand]
  "Return the rank of the quadruplet in a four-of-a-kind as a list."
  (keys (filter #(= 4 (count (val %))) (:ranks (meta hand)))))

(defn triplet [hand]
  "Return the rank of the triplet in a three-of-a-kind as a list."
  (keys (filter #(= 3 (count (val %))) (:ranks (meta hand)))))

(defn pairs [hand]
  "Return a sorted list of the ranks of the pairs in `hand`."
  ;; Not sure if `sort` is necessary here, because the original hand is sorted,
  ;; but the keys are extracted from a hash map, so best to be sure.
  (sort rank> (keys (filter #(= 2 (count (val %))) (:ranks (meta hand))))))

(defn kickers [hand]
  "Return a sorted list of the ranks of the kickers in `hand`.
The kickers are those cards that do not form pairs, triplets or quadruplets."
  (sort rank> (keys (filter #(= 1 (count (val %))) (:ranks (meta hand))))))

;; A hash map of secondary comparison functions. If an entry contains more than
;; one function, they are tried in the order given: if the first function yields
;; equality, the next one is tried, until the list is exhausted.

(def secondary-compare-fns {9 [straight]            ; straight flush
                            8 [quadruplet kickers]  ; four of a kind
                            7 [triplet pairs]       ; full-house
                            6 [all-ranks]           ; flush
                            5 [straight]            ; straight
                            4 [triplet kickers]     ; three-of-a-kind
                            3 [pairs kickers]       ; two-pair
                            2 [pairs kickers]       ; one-pair
                            1 [all-ranks]})         ; high-card

;; Applying these functions yields a list of ranks, which can then be compared
;; using `compare-ranks`. For example, collecting the comparators for "5H 5D 5S
;; 5C 10H", which is a four-of-a-kind, yields the list ("5" "10"): "5" is the
;; rank of the quadruplet, "10" the rank of the kicker. For "5H 10D 10S 10H
;; 10C", however, which is also a four-of-a-kind, the list of secondary
;; comparators is ("10" "5").

(defn collect-comparators [hand fns]
  "Collect the ranks used for secondary comparison.
The return value is a list that is first sorted by priority, then by rank."
  (reduce #(concat %1 (%2 hand)) [] fns))

(defn compare-hands [x y]
  "Three-way comparator for two hands.
Hands are first compared by their category (straight flush, four of a kind,
etc.), represented as a number. Two hands of the same category are further
compared by the ranks of their cards, as defined by `secondary-compare-fns`."
  (let [cat-x (:cat (meta x))
        cat-y (:cat (meta y))]
    (if-not (= cat-x cat-y)
      ;; x and y are reversed because we want to sort from high to low.
      (compare cat-y cat-x)
      (compare-ranks (:seccomp (meta y)) (:seccomp (meta x))))))

(defn hands= [x y]
  (= 0 (compare-hands x y)))

(defn parse-hand [hand]
  "Parse `hand`.
The hand is converted to a list sorted by rank and the following metadata is
added: the original string, groupings of the cards by rank and by suit, the
category and the secondary comparators."
  ;; The metadata is added in two stages, because the groupings by rank and suit
  ;; are needed to determine the category and secondary comparators.
  (let [cards (sort-by rank rank> (string/split hand #"\s"))
        parsed-hand (with-meta cards {:ranks (group-by rank cards)
                                      :suits (group-by suit cards)
                                      :orig hand})
        cat (categorize-hand parsed-hand)
        seccomp (collect-comparators parsed-hand (secondary-compare-fns cat))]
    (vary-meta parsed-hand assoc :cat cat :seccomp seccomp)))

(defn best-hands [hands]
  (let [sorted-hands (->> hands
                          (map parse-hand)
                          (sort compare-hands))]
    (map #(:orig (meta %))
         (take-while #(hands= % (first sorted-hands)) sorted-hands))))


;;Things to remember:

;; `sort` (and other sorting functions) can take a `comparator` argument, which
;; must implement java.util.Comparator. The easiest way to do this is to use
;; `compare` to do the actual comparing, but that won't work if you need to
;; compare elements of different types (as is the case here).
;; See <https://clojure.org/guides/comparators> for details.


;; Notes:

;; As it stands, I should probably have `categorize-hand` return not just the
;; category but also the secondary comparators. As it stands, there doesn't seem
;; to be any reason to extract those separately. (In an earlier version of the
;; code, the secondary comparators weren't stored as metadata but extracted on
;; an as-needed basis in `compare-hands`.)

Community comments

Find this solution interesting? Ask the author a question to learn more.

What can you learn from this solution?

A huge amount can be learned from reading other people’s code. This is why we wanted to give exercism users the option of making their solutions public.

Here are some questions to help you reflect on this solution and learn the most from it.

  • What compromises have been made?
  • Are there new concepts here that you could read more about to improve your understanding?