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

Testare's solution

to Poker in the Clojure Track

Published at Apr 16 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"
          "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)

;; HELPERS

(defn- mapping [f values]
  "Returns map of value -> (f value) "
  (apply merge (map #(hash-map % (f %)) values)))


(defn- flush? [cards]
  (->> cards (map second) distinct count (= 1)))

(defn- n-of-a-kind [n cards]
  "When a hand has exactly n of a card number, this returns those numbers"
    (mapv first (filter #(= n (second %)) (frequencies (map first cards)))))

;; PARSING

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

(def suit {"D" :diamonds "C" :clubs "H" :hearts "S" :spades})

(defn- hand-str->cards [hand-str]
  "Converts hand string to cards, each represented as [number suit], with 13 representing K, etc."
  (sort-by (comp - first)
    (map 
      (juxt 
        #(value (second %)) 
        #(suit (nth % 2))) 
    (re-seq #"([\dAJQK]|10)([DCHS])" hand-str))))


;; HAND COMBINATIONS
; Each of these returns a tie breaker result for the hand combination, or nil if the hand doesn't meet
; the requirements for that combination
; tie breaker results can be sorted to determine winners if more than one hand fits the combination

(defn- cards->high-card [cards]
  (mapv first cards))

(defn- cards->pair [cards]
  (when-let [pair (first (n-of-a-kind 2 cards))]
    (into [pair] (remove #(= pair %) (map first cards)))))

(defn- cards->two-pairs [cards]
  (let [pairs (n-of-a-kind 2 cards)]
    (when (= 2 (count pairs))
      (into pairs (remove #(some #{%} pairs) (map first cards))))))

(defn- cards->three-of-a-kind [cards]
  (when-let [trip (first (n-of-a-kind 3 cards))]
    (into [trip] (remove #(= trip %) (map first cards)))))

(defn- cards->straight [cards]
  (let [high-card-value (ffirst cards)]
    (or 
      (and 
        (= (map first cards) (reverse (range (- high-card-value 4) (inc high-card-value)))) 
        high-card-value)
      (and ; Ace is usually treated like a 14, but it can also be a 1 for a straight.
        (= (mapv first cards) [14 5 4 3 2]) 
        5))))

(defn- cards->flush [cards]
  (when (flush? cards)
    (mapv first cards)))

(defn- cards->full-house [cards]
  (when-let [trip (first (n-of-a-kind 3 cards))]
    (when-let [pair (first (n-of-a-kind 2 cards))]
      [trip pair])))

(defn- cards->four-of-a-kind [cards]
  (when-let [quad (first (n-of-a-kind 4 cards))]
    (into [quad] (remove #(= quad %) (map first cards)))))

(defn- cards->straight-flush [cards]
  (when (flush? cards)
    (cards->straight cards)))

(def combos 
  [cards->straight-flush
   cards->four-of-a-kind
   cards->full-house
   cards->flush
   cards->straight
   cards->three-of-a-kind
   cards->two-pairs
   cards->pair
   cards->high-card])

;; CALCULATION LOGIC

(defn- apply-combo [cards->combo hand-map]
  "Converts map of handstring to cards to a map of handstring to combo result, or nil"
  (reduce 
    #(if-let [applied (cards->combo (second %2))]  ; If there are any hands that meet requirements for this hand combination
       (assoc %1 (first %2) applied) ;Add it to the result as a mapping of hand -> tie breaker result
       %1) 
    nil 
    hand-map))

(defn- reduce-combos [hand-map]
  "Go through the combos until we have some results"
  (->> combos ; For each hand combination, starting at the highest...
       (map #(apply-combo % hand-map)) ;... Check for valid combination hands
       (drop-while nil?) ; Ignore hand combinations with no valid hands
       first)) ; Take the first hand combination that applies

(defn best-hands [hand-strs]
  (->> hand-strs ;String representation of hands
       (mapping hand-str->cards) ; A map of string representation to internal logic representation of hands
       reduce-combos ; Logic to select highest hand combination
       (sort-by second) ;Sort by tie breaker
       reverse ; Highest first
       (partition-by second) ; Group ties
       first ; Select highest group
       (map first) ; Select hand string representations
       vec)) ; To match tests

Community comments

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

Testare's Reflection

Whoa nellie that took a while, and the code looks pretty long, but I feel like this code follows good practices.