Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Poker Hand Scoring in Clojure
(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))))
(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)))
(rankcmp (first ss1) (first ss2)) ; done
(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)))
(defn winning-hand
"Return hand scores and which is the winner"
[h1 h2]
(let [h1s (score h1)
h2s (score h2)
hwin (winning-score h1s h2s)]
{:hand-1-score h1s
:hand-2-score h2s
:winner (str "Hand " (if (= hwin h1s) 1 2))}))
;; examples
;; 1: high-card vs high-card
(winning-hand
[[:ace :hearts] [2 :diamonds] [3 :hearts] [9 :clubs] [:jack :diamonds]]
[[:ace :hearts] [2 :diamonds] [3 :hearts] [10 :clubs] [:jack :diamonds]])
;; {:hand-1-score [:high-card :ace :jack 9 3 2],
;; :hand-2-score [:high-card :ace :jack 10 3 2],
;; :winner "Hand 2"}
;; 2: pair vs high-card
(winning-hand
[[:ace :hearts] [2 :diamonds] [3 :hearts] [9 :clubs] [:jack :diamonds]]
[[:ace :hearts] [:queen :hearts] [:jack :spades] [:ace :diamonds] [10 :hearts]])
;; {:hand-1-score [:high-card :ace :jack 9 3 2],
;; :hand-2-score [:pair :ace :queen :jack 10],
;; :winner "Hand 2"}
;; 2: pair vs pair
(winning-hand
[[:ace :hearts] [:queen :hearts] [:jack :spades] [:ace :diamonds] [10 :hearts]]
[[:king :hearts] [:king :hearts] [:jack :spades] [:ace :diamonds] [10 :hearts]])
;; {:hand-1-score [:pair :ace :queen :jack 10],
;; :hand-2-score [:pair :king :jack :ace 10],
;; :winner "Hand 1"}
;; 3: two-pair vs pair
(winning-hand
[[:ace :hearts] [:ace :diamonds] [:queen :hearts] [:queen :spades] [10 :hearts]]
[[:ace :hearts] [:queen :hearts] [:jack :spades] [:ace :diamonds] [10 :hearts]])
;; {:hand-1-score [:two-pair :ace :queen 10],
;; :hand-2-score [:pair :ace :queen :jack 10],
;; :winner "Hand 1"}
;; 3: two-pair vs two-pair
(winning-hand
[[:ace :hearts] [:ace :diamonds] [:queen :hearts] [:queen :spades] [10 :hearts]]
[[:ace :hearts] [:ace :diamonds] [:king :hearts] [:king :spades] [10 :hearts]])
;; {:hand-1-score [:two-pair :ace :queen 10],
;; :hand-2-score [:two-pair :ace :king 10],
;; :winner "Hand 2"}
;; 4: trips vs two pair
(winning-hand
[[:ace :hearts] [:ace :diamonds] [:ace :clubs] [:jack :hearts] [10 :hearts]]
[[:ace :hearts] [:ace :diamonds] [:king :hearts] [:king :spades] [10 :hearts]])
;; {:hand-1-score [:three-of-a-kind :ace :jack 10],
;; :hand-2-score [:two-pair :ace :king 10],
;; :winner "Hand 1"}
;; 4: trips vs trips
(winning-hand
[[:ace :hearts] [:ace :diamonds] [:ace :clubs] [:jack :hearts] [10 :hearts]]
[[:queen :hearts] [:ace :diamonds] [:queen :clubs] [:queen :hearts] [10 :hearts]])
;; {:hand-1-score [:three-of-a-kind :ace :jack 10],
;; :hand-2-score [:three-of-a-kind :queen :ace 10],
;; :winner "Hand 1"}
;; 5: straight vs trips
(winning-hand
[[:ace :hearts] [:king :diamonds] [:queen :hearts] [:jack :hearts] [10 :hearts]]
[[:queen :hearts] [:ace :diamonds] [:queen :clubs] [:queen :hearts] [10 :hearts]])
;; {:hand-1-score [:straight :ace :king :queen :jack 10],
;; :hand-2-score [:three-of-a-kind :queen :ace 10],
;; :winner "Hand 1"}
;; 5: high straights
(winning-hand
[[:ace :hearts] [:king :diamonds] [:queen :hearts] [:jack :hearts] [10 :hearts]]
[[:king :diamonds] [:queen :hearts] [:jack :hearts] [10 :hearts] [9 :spades]])
;; {:hand-1-score [:straight :ace :king :queen :jack 10],
;; :hand-2-score [:straight :king :queen :jack 10 9],
;; :winner "Hand 1"}
;; 5: low straights
(winning-hand
[[:ace :hearts] [2 :hearts] [3 :spades] [4 :diamonds] [5 :clubs]]
[[6 :hearts] [2 :hearts] [3 :spades] [4 :diamonds] [5 :clubs]])
;; {:hand-1-score [:straight 5 4 3 2 :ace],
;; :hand-2-score [:straight 6 5 4 3 2],
;; :winner "Hand 2"}
;; 5: mixed straights
(winning-hand
[[:ace :hearts] [2 :hearts] [3 :spades] [4 :diamonds] [5 :clubs]]
[[:ace :hearts] [:king :diamonds] [:queen :hearts] [:jack :hearts] [10 :hearts]])
;; {:hand-1-score [:straight 5 4 3 2 :ace],
;; :hand-2-score [:straight :ace :king :queen :jack 10],
;; :winner "Hand 2"}
;; 6: flush v straight
(winning-hand
[[:ace :hearts] [:king :hearts] [2 :hearts] [4 :hearts] [10 :hearts]]
[[:ace :hearts] [2 :hearts] [3 :spades] [4 :diamonds] [5 :clubs]])
;; {:hand-1-score [:flush :ace :king 10 4 2],
;; :hand-2-score [:straight 5 4 3 2 :ace],
;; :winner "Hand 1"}
;; 6: flush v flush
(winning-hand
[[:ace :hearts] [:king :hearts] [2 :hearts] [4 :hearts] [10 :hearts]]
[[:queen :hearts] [:king :hearts] [2 :hearts] [4 :hearts] [10 :hearts]])
;; {:hand-1-score [:flush :ace :king 10 4 2],
;; :hand-2-score [:flush :king :queen 10 4 2],
;; :winner "Hand 1"}
;; 7: full house v flush
(winning-hand
[[:ace :hearts] [:ace :diamonds] [:ace :clubs] [:jack :hearts] [:jack :diamonds]]
[[:ace :hearts] [:king :hearts] [2 :hearts] [4 :hearts] [10 :hearts]])
;; {:hand-1-score [:full-house :ace :jack],
;; :hand-2-score [:flush :ace :king 10 4 2],
;; :winner "Hand 1"}
;; 7: full house v full house
(winning-hand
[[:ace :hearts] [:ace :diamonds] [:ace :clubs] [:queen :hearts] [:queen :diamonds]]
[[:ace :hearts] [:ace :diamonds] [:ace :clubs] [:jack :hearts] [:jack :diamonds]])
;; {:hand-1-score [:full-house :ace :queen],
;; :hand-2-score [:full-house :ace :jack],
;; :winner "Hand 1"}
;; 8: four v full house
(winning-hand
[[:ace :hearts] [:ace :diamonds] [:ace :clubs] [:ace :spades] [:jack :diamonds]]
[[:ace :hearts] [:ace :diamonds] [:ace :clubs] [:queen :hearts] [:queen :diamonds]])
;; {:hand-1-score [:four-of-a-kind :ace :jack],
;; :hand-2-score [:full-house :ace :queen],
;; :winner "Hand 1"}
;; 8: 4 v 4
(winning-hand
[[:ace :hearts] [:ace :diamonds] [:ace :clubs] [:ace :spades] [:jack :diamonds]]
[[:king :hearts] [:king :diamonds] [:king :clubs] [:king :spades] [:jack :diamonds]])
;; {:hand-1-score [:four-of-a-kind :ace :jack],
;; :hand-2-score [:four-of-a-kind :king :jack],
;; :winner "Hand 1"}
;; sf vs 4
(winning-hand
[[:king :hearts] [:queen :hearts] [:jack :hearts] [10 :hearts] [9 :hearts]]
[[:ace :hearts] [:ace :diamonds] [:ace :clubs] [:ace :spades] [:jack :diamonds]])
;; {:hand-1-score [:straight-flush :king :queen :jack 10 9],
;; :hand-2-score [:four-of-a-kind :ace :jack],
;; :winner "Hand 1"}
;; low sf vs low sf
(winning-hand
[[5 :hearts] [4 :hearts] [3 :hearts] [2 :hearts] [:ace :hearts]]
[[5 :hearts] [4 :hearts] [3 :hearts] [2 :hearts] [6 :hearts]])
;; {:hand-1-score [:straight-flush 5 4 3 2 :ace],
;; :hand-2-score [:straight-flush 6 5 4 3 2],
;; :winner "Hand 2"}
;; royal vs sf
(winning-hand
[[:ace :hearts] [:king :hearts] [:queen :hearts] [:jack :hearts] [10 :hearts]]
[[:king :hearts] [:queen :hearts] [:jack :hearts] [10 :hearts] [9 :hearts]])
;; {:hand-1-score [:royal-flush :ace :king :queen :jack 10],
;; :hand-2-score [:straight-flush :king :queen :jack 10 9],
;; :winner "Hand 1"}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment