|
(defn rank [v] |
|
(get {:jack 11 |
|
:queen 12 |
|
:king 13 |
|
:ace 14} |
|
v |
|
v)) |
|
|
|
(defn rank-name [r] |
|
(get {14 "Ace" |
|
13 "King" |
|
12 "Queen" |
|
11 "Jack"} |
|
r |
|
r)) |
|
|
|
(defn parse-hand [h] |
|
{:suits (set (map second h)) |
|
:ranks (sort (map #(rank (first %)) h))}) |
|
|
|
(defn rank-freqs [ranks] |
|
(let [freqs (frequencies ranks)] |
|
(sort-by (juxt :cnt :rank) |
|
#(compare %2 %1) |
|
(for [[rnk cnt] freqs] |
|
{:cnt cnt |
|
:rank rnk})))) |
|
|
|
(defn sorted-kickers [freqs] |
|
(sort > (for [{:keys [cnt rank]} freqs |
|
:when (= 1 cnt)] |
|
rank))) |
|
|
|
(defn score [h] |
|
(let [{:keys [suits ranks]} (parse-hand h) |
|
[low high] ((juxt first last) ranks) |
|
flush? (= 1 (count suits)) |
|
straight? (or (= 4 (- high low)) |
|
(= ranks [2 3 4 5 14])) |
|
freqs (rank-freqs ranks) |
|
kickers (sorted-kickers freqs) |
|
[freq1 freq2] freqs |
|
freq-cnt (fn [freq] (or (:cnt freq) 0))] |
|
(cond |
|
(and straight? |
|
flush? |
|
(= 10 low)) [:royal-flush] |
|
(and straight? flush?) [:straight-flush (if (= ranks [2 3 4 5 14]) |
|
5 |
|
high)] |
|
(= 4 (:cnt freq1)) [:four-of-a-kind (:rank freq1) kickers] |
|
(and (= 3 (freq-cnt freq1)) |
|
(= 2 (freq-cnt freq2))) [:full-house (:rank freq1) (:rank freq2)] |
|
flush? [:flush (sort > ranks)] |
|
straight? [:straight (if (= ranks [2 3 4 5 14]) |
|
5 |
|
high)] |
|
(= 3 (freq-cnt freq1)) [:three-of-a-kind (:rank freq1) kickers] |
|
(and (= 2 (freq-cnt freq1)) |
|
(= 2 (freq-cnt freq2))) [:two-pair (:rank freq1) (:rank freq2) kickers] |
|
(= 2 (freq-cnt freq1)) [:one-pair (:rank freq1) kickers] |
|
:else [:high-card (sort > ranks)]))) |
|
|
|
(defn describe-hand [h] |
|
(let [sc (score h) |
|
[hand-type & args] sc |
|
rank-str (fn [rnk] (rank-name rnk))] |
|
(case hand-type |
|
:royal-flush "Royal Flush!" |
|
:straight-flush (format "Straight Flush, %s high" (rank-str (first args))) |
|
:four-of-a-kind (format "Four %s's, %s kicker" |
|
(rank-str (first args)) |
|
(rank-str (first (second args)))) |
|
:full-house (format "Full House: %s's over %s's" |
|
(rank-str (first args)) |
|
(rank-str (second args))) |
|
:flush (format "Flush: %s high" (rank-str (first args))) |
|
:straight (format "Straight: %s high" (rank-str (first args))) |
|
:three-of-a-kind (format "Three %s's, kickers: %s" |
|
(rank-str (first args)) |
|
(map rank-str (second args))) |
|
:two-pair (format "Two Pair: %s's and %s's, %s kicker" |
|
(rank-str (first args)) |
|
(rank-str (second args)) |
|
(rank-str (first (last args)))) |
|
:one-pair (format "Pair of %s's, kickers: %s" |
|
(rank-str (first args)) |
|
(rank-str (second args))) |
|
:high-card (format "%s high, kickers: %s" |
|
(rank-str (first args)) |
|
(rank-str (second args)))))) |
|
|
|
(defn winner [h1 h2] |
|
(let [rank-map (into {} (map-indexed (fn [idx itm] [itm idx]) |
|
[:high-card :one-pair :two-pair |
|
:three-of-a-kind :straight :flush |
|
:full-house :four-of-a-kind |
|
:straight-flush :royal-flush])) |
|
hand-rank (fn [h] |
|
(let [[hand-type & args] (score h)] |
|
[(get rank-map hand-type) (vec args)])) |
|
rank-compare (compare (hand-rank h1) (hand-rank h2)) |
|
winning-hand (cond |
|
(neg? rank-compare) h2 |
|
(pos? rank-compare) h1 |
|
:else :draw)] |
|
{:winner winning-hand |
|
:description (if (= :draw winning-hand) |
|
"Draw" |
|
(describe-hand winning-hand))})) |
|
|
|
(comment |
|
(def h1 [[3 :diamonds] [3 :hearts] [3 :spades] [5 :hearts] [:king :clubs]]) |
|
(def h2 [[10 :diamonds] [10 :hearts] [10 :spades] [5 :hearts] [5 :clubs]]) |
|
(def h3 [[10 :diamonds] [10 :hearts] [ 5 :spades] [ 5 :clubs] [ 7 :clubs]]) |
|
(def h4 [[ 5 :diamonds] [ 5 :hearts] [10 :spades] [ 7 :clubs] [ 2 :clubs]]) |
|
(def h5 [[:ace :clubs] [:king :clubs] [:queen :clubs] [:jack :clubs] [10 :clubs]]) |
|
(def h6 [[:ace :spades] [:king :clubs] [:queen :clubs] [:jack :clubs] [10 :clubs]]) |
|
(def h7 [[:ace :clubs] [2 :spades] [3 :clubs] [4 :clubs] [5 :clubs]]) |
|
(def h8 [[:ace :clubs] [2 :clubs] [3 :clubs] [4 :clubs] [5 :clubs]]) |
|
|
|
(winner h1 h2) |
|
(winner h2 h4) |
|
(winner h3 h4) |
|
|
|
(winner h5 h6) |
|
|
|
(winner h6 h7) |
|
(winner h7 h1) |
|
|
|
(winner h5 h2) |
|
(winner h6 h2) |
|
(winner h6 h1) |
|
(winner h7 h4) |
|
(winner h7 h8) |
|
(winner h2 h8) |
|
(winner h2 h7) |
|
) |
I forgot that aces can be low in straights e.g. A♣ 2♣ 3♣ 4♣ 5♣. Here's a tweaked version that fixes that: