Skip to content

Instantly share code, notes, and snippets.

@ericnormand
Last active March 27, 2022 23:45
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ericnormand/fbc9b6386a66c1ece590930db07ac604 to your computer and use it in GitHub Desktop.
Save ericnormand/fbc9b6386a66c1ece590930db07ac604 to your computer and use it in GitHub Desktop.

Poker hand ranking, revisited

Last week, the challenge was to write a function to score a poker hand. It took a hand of poker cards and returned a keyword naming the hand. For instance:

(score [[3 :diamonds] [3 :hearts] [3 :spades] [5 :hearts] [:king :clubs]])
=> :three-of-a-kind ;; three 3s

Cards are represented as a tuple of rank (number or name if it's a face card) and suit. Face card names are the keywords :ace, :king, :queen, :jack. Suits are :diamonds, :spades, :hearts, :clubs.

However, this doesn't tell the whole story. What if two players both got two pairs? In the rules of poker, the hand with the pair with the highest rank wins. If I have a pair of Aces and a pair of 2s, and you have a pair of Kings and a pair of Queens, I win, even though both hands are two pairs.

The keyword return value from last week doesn't contain that information. The challenge for this week has two parts: 1) make score return not just a keyword, but a tuple, and 2) write a function to compare these tuples to determine a winner.

Here is what the score function should return now:

(score [[:ace :diamonds] [2 :spades] [:ace :clubs] [2 :clubs] [5 :spades]])
=> [:two-pair :ace 2 5]
(score [[:ace :spades] [:queen :clubs] [:queen :diamonds] [:king :hearts] [:king :diamonds]])
=> [:two-pair :king :queen :ace]

The tuple contains the name of the hand, followed by the high cards, followed by the "kickers" (tie breakers). In the above example, the 5 is the kicker since it isn't part of the two pairs but might be useful for breaking ties.

The second part of the challenge is to write a function winning-score that chooses the winner between two scores.

(winning-score [:two-pair :ace 2 5]
               [:two-pair :king :queen :ace])
=> [:two-pair :ace 2 5]

The way the scores work, you should be able to compare the high cards and kickers in order after comparing the hand name.

Here is a summary of the high card rules:

  • Royal Flush: Ace, King, Queen, Jack, and 10 are the high cards, in that order
  • Straight Flush: All cards are high cards in order, starting with the highest rank
  • Four of a kind: The rank of the set of four is high, the fifth card is the kicker
  • Full house: The set of three is the first high card, the set of two second
  • Flush: All cards are high cards in order, starting with the highest rank
  • Straight: Five consecutive cards, not in same suit (careful, Aces could be low if it's Ace 2 3 4 5)
  • Three of a kind: The rank of the set of three is high, then the rest are kickers in order
  • Two pair: The highest pair first, then the second, the last card is the kicker
  • Pair: The rank of the pair is high, then the rest are kickers in order
  • High card: All cards are kickers, in order

Please see this site for more details and examples of scoring. You may also want to refer to last week's challenge for more details.

Note that the suit does not play into comparing hands. A flush of spades is the same as a flush of hearts. Just the high card and kicker ranks count if both hands are flushes.

Note also that ties are still possible if the scores are the same. This can happen in poker. The winning-score should return either one, since they are equal.

You may modify your submission from last week or work from someone else's for this challenge.

(ns functional-tv-puzzles.-2020.poker-win-375-golf)
(def ranks-cycle (cycle (into [:ace :king :queen :jack]
(range 10 1 -1))))
(def ordering (-> (take 13 ranks-cycle) (zipmap (range))))
(def order (partial sort-by ordering))
(defn rank [card]
(first card))
(defn suit [card]
(last card))
(defn same-suit? [cards]
(apply = (map suit cards)))
(defn n-groups
"Returns a partition of xs according to f, ordered by decreasing size"
([xs]
(n-groups xs identity))
([xs f]
(->> xs
(group-by f)
vals
(sort-by (comp - count)))))
(defn first-group [xs]
(first (n-groups xs)))
(defn count? [n xs]
(<= n (count xs)))
(defn n-count-group?
"Returns truee iff for each n in ns (count? n group) is true for
its respective argument in groups"
[ns groups]
(every? identity
(map (fn [n xs]
(count? n xs))
ns
groups)))
(defn cursor [x]
(let [align (fn forward [xs]
(if (= x (first xs))
xs
(forward (rest xs))))]
(align ranks-cycle)))
(defn consecutive?
[xs]
(when (->> xs first cursor
(take (count xs))
(= xs))
xs))
(defn consecutive-lowace? [xs]
(consecutive? (-> xs rest vec (conj (first xs)))))
(defn kickers [from sel]
(->> from (remove (set sel))
order))
(defn fmt
([label xs]
(fmt label xs xs))
([label xs from]
(fmt label xs from nil))
([label xs from xf]
(let [sel ((or xf identity) xs)]
(-> [label]
(into sel)
(into (kickers from sel))))))
(defn score [hand]
(let [same-suit? (same-suit? hand)
rs (->> hand
(map rank)
order)
consec? (consecutive? rs)]
(cond
(and same-suit? consec? (= :ace (first rs)))
(fmt :royal-flush rs rs)
(and same-suit? consec?)
(fmt :straight-flush rs rs)
(and same-suit? (consecutive-lowace? rs))
(fmt :straight-flush [5 4 3 2 :ace], rs)
(n-count-group? [4], (n-groups rs))
(fmt :four-of-a-kind (distinct (first-group rs)), rs)
(n-count-group? [3 2], (n-groups rs))
(fmt :full-house (take 2 (n-groups rs)), rs, #(map first %))
same-suit?
(fmt :flush rs rs)
(consecutive? rs)
(fmt :straight rs rs)
(consecutive-lowace? rs)
(fmt :straight [5 4 3 2 :ace])
(n-count-group? [3] (n-groups rs))
(fmt :three-of-a-kind (distinct (first-group rs)), rs)
(n-count-group? [2 2] (n-groups rs))
(fmt :two-pair (take 2 (n-groups rs)), rs, #(order (map first %)))
(count? 2 (first-group rs))
(fmt :pair (distinct (first-group rs)), rs)
:else
(fmt :high-card rs rs))))
(def score-ordering (zipmap
[:royal-flush :straight-flush :four-of-a-kind :full-house
:flush :straight :three-of-a-kind :two-pair :pair :high-card]
(range)))
(defn winning-score [s1 s2]
(->> (cons score-ordering
(repeat ordering))
(map vector s1 s2)
(reduce (fn [_ [x1 x2 ranking]]
(case (compare (ranking x1) (ranking x2))
-1 (reduced s1)
1 (reduced s2)
0 s1))
nil)))
;; Part 1: make score return not just a keyword, but a tuple
(defn pk-ranksort
"Sort the supplied collection of card ranks using poker rules."
[c]
(let [rankmap (zipmap
(concat [:ace :king :queen :jack] (range 10 1 -1))
(range 14 1 -1))]
(sort-by #(get rankmap %) c)))
(defn getkeyswithval
"Return a list of all keys in map m that map to value v."
[m v]
(vec (keep #(when (= (val %) v) (key %)) m)))
(defn fixacelow
"Correct the sorting of straights when :ace is low."
[s]
(let [ff (frequencies s)]
(if (and (:ace ff) (get ff 2)) [5 4 3 2 :ace] s)))
(defn score
"Return a tuple representing the best score that can be made from the hand."
[hand]
(let [isflush (apply = (map second hand))
ranks (map first hand)
rsranks (reverse (pk-ranksort ranks))
fq (frequencies ranks)
keyswith (partial getkeyswithval fq)
fs (sort (vals fq))
match-ranks? #(= (set ranks) (set %))
rank-seq (concat [:ace :king :queen :jack] (range 10 1 -1) [:ace])
straight? (some match-ranks? (partition 5 1 rank-seq))
vc (fn [& s] (vec (apply concat s)))]
(cond
(and isflush (match-ranks? (take 5 rank-seq)))
[:royal-flush :ace :king :queen :jack 10]
(and straight? isflush) (vc [:straight-flush] (fixacelow rsranks))
(= '(1 4) fs) (vc [:four-of-a-kind] (keyswith 4) (keyswith 1))
(= '(2 3) fs) (vc [:full-house] (keyswith 3) (keyswith 2))
isflush (vc [:flush] rsranks)
straight? (vc [:straight] (fixacelow rsranks))
(= '(1 1 1 2) fs) (vc [:pair] (keyswith 2) (keyswith 1))
(= '(1 1 3) fs) (vc [:three-of-a-kind] (keyswith 3) (keyswith 1))
(= '(1 2 2) fs) (vc [:two-pair] (keyswith 2) (keyswith 1))
:else (vc [:high-card] rsranks))))
;; part 2: write a function to compare these tuples to determine a winner.
(defn pk-wincmp
"Compare two poker hand types."
[s1 s2]
(let [winmap (zipmap
[:royal-flush :straight-flush :four-of-a-kind
:full-house :flush :straight :three-of-a-kind
:two-pair :pair :high-card]
(range 10 0 -1))]
(> (s1 winmap) (s2 winmap))))
(defn rankcmp
"Compare two poker ranks"
[r1 r2]
(let [rankmap (zipmap
(concat [:ace :king :queen :jack] (range 10 1 -1))
(range 14 1 -1))]
(cond
(nil? r1) false
(nil? r2) true
:else (> (get rankmap r1) (get rankmap r2)))))
(defn compare-ranklists
"Compare two lists of poker ranks"
[s1 s2]
(loop [ss1 s1 ss2 s2]
(if (or (empty? ss1) (empty? ss2)
(not= (first ss1) (first ss2)))
(if (rankcmp (first ss1) (first ss2)) s1 s2) ; if
(recur (rest ss1) (rest ss2)))))
(defn winning-score
"Choose a winner among two poker hand scores."
[s1 s2]
(if (not= (first s1) (first s2))
(if (pk-wincmp (first s1) (first s2)) s1 s2) ;; a winner!
(if (compare-ranklists (rest s1) (rest s2)) s1 s2)))
(def hand-names [:royal-flush :straight-flush :four-of-a-kind :full-house :flush :straight :three-of-a-kind :two-pair :pair :high-card])
(def ace-high (into [:ace :king :queen :jack] (range 10 1 -1)))
(def ace-high-index (zipmap ace-high (range)))
(defn sort-ranks [xs]
(sort-by ace-high-index xs))
(defn score [hand]
(let [same-suit? (apply = (map second hand))
hand-ranks (sort-ranks (map first hand))
wheel [5 4 3 2 :ace]
wheel-ranks? (= (sort-ranks wheel) hand-ranks)
high-straight-ranks? (some #{hand-ranks} (partition 5 1 ace-high))
rank-freqs (frequencies hand-ranks)
kind-ranks (fn [freq] (filter #(= freq (rank-freqs %)) ace-high))
has-kind? #(seq (kind-ranks %))
high-cards-and-kickers (mapcat kind-ranks (range 4 0 -1))]
(cond
(and same-suit? (= hand-ranks (take 5 ace-high))) (into [:royal-flush] hand-ranks)
(and same-suit? wheel-ranks?) (into [:straight-flush] wheel)
(and same-suit? high-straight-ranks?) (into [:straight-flush] hand-ranks)
(has-kind? 4) (into [:four-of-a-kind] high-cards-and-kickers)
(and (has-kind? 3) (has-kind? 2)) (into [:full-house] high-cards-and-kickers)
same-suit? (into [:flush] hand-ranks)
wheel-ranks? (into [:straight] wheel)
high-straight-ranks? (into [:straight] hand-ranks)
(has-kind? 3) (into [:three-of-a-kind] high-cards-and-kickers)
(= 2 (count (kind-ranks 2))) (into [:two-pair] high-cards-and-kickers)
(has-kind? 2) (into [:pair] high-cards-and-kickers)
:else (into [:high-card] hand-ranks))))
(defn compare-hand-names [x y]
(let [index (zipmap hand-names (range))]
(compare (index x) (index y))))
(defn compare-rank-seqs [xs ys]
(compare (mapv ace-high-index xs) (mapv ace-high-index ys)))
(defn compare-scores [[x-hand-name & x-ranks] [y-hand-name & y-ranks]]
(let [name-compare (compare-hand-names x-hand-name y-hand-name)]
(if (zero? name-compare)
(compare-rank-seqs x-ranks y-ranks)
name-compare)))
(defn winning-score [& xs]
(first (sort compare-scores xs)))
(ns purelyfunctional-newsletters.issue-375
(:refer-clojure :exclude [flush])
(:require [clojure.test :refer :all]))
(def tag-values {:royal-flush 0
:straight-flush -1
:four-of-a-kind -2
:full-house -3
:flush -4
:straight -5
:three-of-a-kind -6
:two-pair -7
:pair -8
:high-card -9})
(def rank-values {:jack 11
:queen 12
:king 13
:ace 14})
;; as per my understanding it can be only in Straight
(def rank-values* (merge rank-values {:ace 1}))
(defn rank-value [rank]
(or (get rank-values rank)
rank))
(defn rank-value* [rank]
(or (get rank-values* rank)
rank))
(defn rank-value-fn-for-straight [ranks]
(if (-> ranks
set
(contains? 2))
rank-value*
rank-value))
(defn group-by-rank [hand]
(group-by first hand))
(defn hand-ranks [hand]
(map first hand))
(defn hand-suits [hand]
(map second hand))
(defn same-suits? [hand]
(apply = (map second hand)))
(defn consecutives-by? [rank-value-fn hand]
(let [sorted-ranks (->> (hand-ranks hand) (map rank-value-fn) sort)
first-rank (first sorted-ranks)]
(= sorted-ranks
(take (count sorted-ranks) (iterate inc first-rank)))))
(defn n-of-a-kind? [hand min-number-of-groups min-group-size]
(->> (group-by-rank hand)
vals
(filter #(>= (count %) min-group-size))
(#(>= (count %) min-number-of-groups))))
(defn royal-flush?
"Royal Flush: Ace, King, Queen, Jack, and 10 of the same suit"
[hand]
(let [card-ranks (->> (hand-ranks hand)
(into #{}))]
(and (same-suits? hand)
(= card-ranks #{:ace :king :queen :jack 10}))))
(defn straight-flush?
"Straight Flush: Five consecutive cards of the same suit"
[hand]
(and (= 5 (count hand))
(same-suits? hand)
(consecutives-by? rank-value* hand)))
(defn four-of-a-kind?
"Four of a kind: Four cards of the same rank"
[hand]
(n-of-a-kind? hand 1 4))
(defn full-house?
"Full house: Three of a kind and a pair"
[hand]
(let [freq (->> (hand-ranks hand)
frequencies
(into {} (map (juxt val key))))]
(and (freq 3) (freq 2))))
(defn flush?
"Flush: Any five cards of the same suit"
[hand]
(->> (hand-suits hand)
frequencies
(filter #(>= (second %) 5))
((comp not empty?))))
(defn straight?
"Straight: Five consecutive cards, not in same suit"
[hand]
(and (= 5 (count hand))
(not (same-suits? hand))
(or (consecutives-by? rank-value hand)
(consecutives-by? rank-value* hand))))
(defn three-of-a-kind?
"Three of a kind: Three cards of the same rank"
[hand]
(n-of-a-kind? hand 1 3))
(defn two-pair?
"Two pair: Two different pairs"
[hand]
(n-of-a-kind? hand 2 2))
(defn pair?
"Pair: Two cards of the same rank"
[hand]
(n-of-a-kind? hand 1 2))
(defn score-result [hand tag rank-value-fn]
(let [ranks (->> (hand-ranks hand)
frequencies
seq
;; sort in descending order
;; 1) by rank frequency
;; 2) then by rank
(sort (fn [[rnk1 cnt1] [rnk2 cnt2]]
(compare [cnt2 (rank-value-fn rnk2)]
[cnt1 (rank-value-fn rnk1)])))
(map first))]
(into [tag] ranks)))
(defn make-score-result [hand score-tag]
(if (= :royal-flush score-tag)
[score-tag]
(let [rank-value-fn (case score-tag
:straight-flush rank-value*
:straight (-> (hand-ranks hand)
rank-value-fn-for-straight)
rank-value)]
(score-result hand score-tag rank-value-fn))))
(defn score [hand]
(let [score-tag (cond
(royal-flush? hand) :royal-flush
(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-pair? hand) :two-pair
(pair? hand) :pair
:else :high-card)]
(make-score-result hand score-tag)))
(defn pad [coll n v]
(take n
(concat coll (repeat v))))
(defn normalize [coll]
"Output format: [:tag card1 card2 card3 card4 card5]
Missing cards have score `0`"
(-> coll
(pad 6 0)
vec))
;; Example of an input: [:pair 10 2 3 4]
(defn scored-hand [score]
(let [[tag & more] score
rank-value-fn (if (= :straight tag)
(rank-value-fn-for-straight more)
rank-value)
tag-value (get tag-values tag)
result (into [tag-value] (map rank-value-fn more))]
(normalize result)))
(defn winning-score [score1 score2]
(let [h1 (scored-hand score1)
h2 (scored-hand score2)]
(case (compare h1 h2)
-1 score2
score1)))
(deftest score-testing
(is (= [:royal-flush]
(score [[10 :hearts] [:jack :hearts] [:queen :hearts]
[:ace :hearts] [:king :hearts]])))
(is (= [:straight-flush 6 5 4 3 2]
(score [[2 :spades] [3 :spades] [4 :spades]
[5 :spades] [6 :spades]])))
(is (= [:straight-flush 5 4 3 2 :ace]
(score [[:ace :spades] [2 :spades] [3 :spades]
[4 :spades] [5 :spades]])))
(is (= [:four-of-a-kind 3 :king]
(score [[:king :clubs] [3 :hearts] [3 :spades]
[3 :diamonds] [3 :clubs]])))
(is (= [:four-of-a-kind 10 8]
(score [[10 :spades] [10 :clubs] [8 :diamonds]
[10 :diamonds] [10 :hearts]])))
(is (= [:full-house 10 8]
(score [[10 :spades] [10 :clubs] [8 :diamonds]
[10 :diamonds] [8 :hearts]])))
(is (= [:flush :ace :jack 10 8 5]
(score [[:ace :spades] [10 :spades] [8 :spades]
[:jack :spades] [5 :spades]])))
(is (= [:straight 5 4 3 2 :ace]
(score [[:ace :hearts] [2 :spades] [4 :spades]
[3 :spades] [5 :spades]])))
(is (= [:straight :ace :king :queen :jack 10]
(score [[:ace :hearts] [:king :spades] [:jack :spades]
[:queen :spades] [10 :spades]])))
(is (= [:three-of-a-kind 3 :king 5]
(score [[3 :diamonds] [3 :hearts] [3 :spades]
[5 :hearts] [:king :clubs]])))
(is (= [:two-pair :ace 2 5]
(score [[:ace :diamonds] [2 :spades] [:ace :clubs]
[2 :clubs] [5 :spades]])))
(is (= [:two-pair :king :queen :ace]
(score [[:ace :spades] [:queen :clubs] [:queen :diamonds]
[:king :hearts] [:king :diamonds]])))
(is (= [:pair :ace :king :queen 10]
(score [[:ace :spades] [:queen :clubs] [10 :diamonds]
[:ace :hearts] [:king :diamonds]])))
(is (= [:high-card :ace :queen 9 5 3]
(score [[3 :hearts] [5 :hearts] [:queen :spades]
[9 :hearts] [:ace :diamonds]]))))
(deftest winning-score-testing
(is (= [:two-pair :ace 2 5]
(winning-score [:two-pair :ace 2 5]
[:two-pair :king :queen :ace])))
(is (= [:royal-flush]
(winning-score [:royal-flush]
[:royal-flush])))
(is (= [:royal-flush]
(winning-score [:straight-flush 6 5 4 3 2]
[:royal-flush])))
(is (= [:straight-flush 6 5 4 3 2]
(winning-score [:four-of-a-kind 3 :king]
[:straight-flush 6 5 4 3 2])))
(is (= [:straight-flush 5 4 3 2 :ace]
(winning-score [:straight-flush 5 4 3 2 :ace]
[:high-card 10 9 8 7 6])))
(is (= [:four-of-a-kind 3 :king]
(winning-score [:full-house 10 8]
[:four-of-a-kind 3 :king])))
(is (= [:four-of-a-kind 10 8]
(winning-score [:four-of-a-kind 10 8]
[:flush :ace :jack 10 8 5])))
(is (= [:full-house 10 8]
(winning-score [:flush :ace :jack 10 8 5]
[:full-house 10 8])))
(is (= [:flush :ace :jack 10 8 5]
(winning-score [:straight 5 4 3 2 :ace]
[:flush :ace :jack 10 8 5])))
(is (= [:straight 10 9 8 7 6]
(winning-score [:straight 5 4 3 2 :ace]
[:straight 10 9 8 7 6])))
(is (= [:straight :ace :king :queen :jack 10]
(winning-score [:three-of-a-kind 3 :king 5]
[:straight :ace :king :queen :jack 10])))
(is (= [:three-of-a-kind 3 :king 5]
(winning-score [:three-of-a-kind 3 :king 5]
[:two-pair :ace 2 5])))
(is (= [:two-pair :ace 2 5]
(winning-score [:two-pair :ace 2 5]
[:two-pair :king :queen :ace])))
(is (= [:two-pair :king :queen :ace]
(winning-score [:two-pair :king :queen :ace]
[:pair :ace :king :queen 10])))
(is (= [:two-pair :king :queen :ace]
(winning-score [:two-pair :king :queen :ace]
[:two-pair :king :queen :ace])))
(is (= [:pair :ace :king :queen 10]
(winning-score [:pair :ace :king :queen 10]
[:high-card :ace :queen 9 5 3])))
(is (= [:high-card :ace :queen 9 5 3]
(winning-score [:high-card :ace :queen 9 5 3]
[:high-card :ace 10 9 8 7]))))
@KingCode
Copy link

KingCode commented May 1, 2020

Here are my tests for the new score function: could someone please let me know if anything is wrong? Thanks!

(defn is= [exp cards] (is (= exp (score cards))))
(defn isnot= [exp cards] (is (not= exp (score cards))))

(deftest score-test
  (testing "Royal Flush"
    (is=  [:royal-flush :ace :king :queen :jack 10] 
          [[10 :clubs][:ace :clubs][:queen :clubs][:jack :clubs][:king :clubs]]))
  (testing "Straight Flush"
    (is= [:straight-flush :jack 10 9 8 7] 
         [[:jack :hearts][8 :hearts][10 :hearts][7 :hearts] [9 :hearts]])
    (is= [:straight-flush 5 4 3 2 :ace]
         [[4 :clubs] [2 :clubs] [5 :clubs] [:ace :clubs] [3 :clubs]]))
  (testing "Four of a Kind"
    (is= [:four-of-a-kind 2 3] 
         [[2 :clubs] [3 :hearts] [2 :diamonds] [2 :spades] [2 :hearts]]))
  (testing "Full House"
    (is= [:full-house 7 4] 
         [[7 :clubs] [4 :hearts] [7 :spades][4 :diamonds] [7 :diamonds]]))
  (testing "Flush"
    (is= [:flush :ace :jack 9 4 3] 
         [[:ace :hearts] [3 :hearts] [4 :hearts] [:jack :hearts] [9 :hearts]]))
  (testing "Straight"
    (is= [:straight 8 7 6 5 4] 
         [[8 :hearts] [4 :hearts] [7 :spades] [5 :clubs] [6 :diamonds]])
    (is= [:straight 5 4 3 2 :ace] 
         [[3 :clubs] [2 :hearts] [5 :diamonds] [:ace :spades] [4 :clubs]]))
  (testing "Three of a Kind"
    (is= [:three-of-a-kind 4 :ace 2] 
         [[:ace :clubs] [4 :hearts] [2 :hearts] [4 :diamonds] [4 :spades]]))
  (testing "Two Pair"
    (is= [:two-pair :ace 8 2] 
         [[8 :diamonds] [8 :clubs] [:ace :spades] [2 :hearts] [:ace :hearts]]))
  (testing "Pair"
    (is= [:pair 2 :king 9 3] 
         [[2 :hearts] [2 :clubs] [3 :hearts] [:king :spades] [9 :diamonds]]))
  (testing "High Card"
    (is= [:high-card :ace :queen 7 5 2] 
         [[:ace :diamonds] [:queen :hearts] [5 :spades] [7 :clubs] [2 :hearts]])))

@steffan-westcott
Copy link

@KingCode Your tests for the new score function look good, they pass against my challenge answer.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment