ðŸŽ‰ Exercism Research is now launched. Help Exercism, help science and have some fun at research.exercism.io ðŸŽ‰

# 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"])))

(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)))

"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`.)``````