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

## to Poker in the Clojure Track

Published at Apr 10 2021 · 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"

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

(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 :refer [split upper-case]]))

(def rank-value {"2" 2, "3" 3, "4" 4, "5" 5, "6" 6, "7" 7, "8" 8, "9" 9, "10" 10, "J" 11, "Q" 12, "K" 13, "A" 14})

(def category-value
(zipmap [:high-card :pair :two-pair :three-of-a-kind :straight :flush :full-house :four-of-a-kind :straight-flush :royal-straight-flush]
(range)))

(defn- ranks
"Gets all the ranks of the cards."
[cards]
(map :rank cards))

(defn- suits
"Gets all the suits of the cards."
[cards]
(map :suit cards))

(defn- count-rank-frequency
"Counts how many times there are num cards of the same rank in."
[cards num]
(let [r (ranks cards)]
(->> r
frequencies
(filter (fn [[_ n]] (= num n)))
count)))

(defn- pair? [cards]
(and (= 1 (count-rank-frequency cards 2))
(= 0 (count-rank-frequency cards 3))))

(defn- two-pair? [cards]
(= 2 (count-rank-frequency cards 2)))

(defn- three-of-a-kind? [cards]
(and (= 1 (count-rank-frequency cards 3))
(= 0 (count-rank-frequency cards 2))))

(defn- straight? [cards]
(let [r (sort (ranks cards))
num (count r)]
(= r (take num (range (first r) (inc (last r)))))))

(defn- flush? [cards]
(apply = (suits cards)))

(defn- full-house? [cards]
(and (= 1 (count-rank-frequency cards 3))
(= 1 (count-rank-frequency cards 2))))

(defn- four-of-a-kind? [cards]
(= 1 (count-rank-frequency cards 4)))

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

(defn- royal-straight-flush? [cards]
(and (flush? cards)
(= (into #{} (map rank-value ["10" "J" "Q" "K" "A"])) (into #{} (ranks cards)))))

(defn- category [cards]
(cond
(royal-straight-flush? cards) :royal-straight-flush
(straight-flush? cards)       :straight-flush
(four-of-a-kind? cards)       :four-of-a-kind
(full-house? cards)           :full-house
(flush? cards)                :flush
(straight? cards)             :straight
(three-of-a-kind? cards)      :three-of-a-kind
(two-pair? cards)             :two-pair
(pair? cards)                 :pair
:else                         :high-card))

(defn- aces-low [cards]
(map #(if (= (:rank %) (rank-value "A")) (assoc % :rank 1) %) cards))

(defn- aces-low-if-low-straight
"Changes any ace from high value to low value (1) so we can test for a straight with a low ace."
[cards]
(let [cards' (aces-low cards)]
(if (straight? cards') cards' cards)))

(defn- normalize-cards
"Groups and sorts cards by rank, making aces low if it makes a straight."
[cards]
(->> cards
(sort-by :rank >)
(partition-by :rank)
(sort-by count >)
flatten
aces-low-if-low-straight))

(defn- str->card
"Converts the string representation of a card (e.g. QH) into a map containing :rank and suit"
[s]
(->> s
(re-find #"([2-9]|10|[JQKA]+)([SHDC])")
(#(assoc {} :rank (rank-value (nth % 1)) :suit (nth % 2)))))

(defn- hand->cards
"Converts the string representation of a hand into a sequence of hashmaps representing the cards in the hand."
[hand]
(let [hand (upper-case hand)]
(->> (split hand #"\s+")
(map str->card)
normalize-cards)))

(defn- score [cards]
;; See https://stackoverflow.com/a/42396124
(reduce (fn [bits card] (+ (bit-shift-left bits 4) (:rank card)))
(category-value (category cards))
cards))

(defn best-hands [hands]
(->> hands
(sort-by (comp score hand->cards))
(partition-by (comp score hand->cards))
last))``````