Skip to content

Instantly share code, notes, and snippets.

@ericnormand
Last active April 28, 2020 04:56
Show Gist options
  • Save ericnormand/bf1408eb11d4c9a36a786cab946ef0c2 to your computer and use it in GitHub Desktop.
Save ericnormand/bf1408eb11d4c9a36a786cab946ef0c2 to your computer and use it in GitHub Desktop.

Poker hand ranking

Write a function that tells you the best scoring for a given poker hand of 5 cards. 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.

Here are the hands, in order of importance:

  • Royal Flush: Ace, King, Queen, Jack, and 10 of the same suit
  • Straight Flush: Five consecutive cards of the same suit
  • Four of a kind: Four cards of the same rank
  • Full house: Three of a kind and a pair
  • Flush: Any five cards of the same suit
  • Straight: Five consecutive cards, not in same suit
  • Three of a kind: Three cards of the same rank
  • Two pair: Two different pairs
  • Pair: Two cards of the same rank
  • High card: No other hand available

Thanks to this site for the challenge idea where this is considered Expert level.

You can leave comments on these submissions in the gist itself. Please leave comments! You can also hit the Subscribe button to keep abreast of the comments. We’re all here to learn.

(ns baritonehands.poker)
(def ace-high
(->> (map vector [2 3 4 5 6 7 8 9 10 :jack :queen :king :ace] (range))
(into {})))
(defn ace? [[card _]]
(= card :ace))
(defn rank [[card suit]]
(ace-high card))
(defn n-of-a-kind? [n cards]
(let [counts (frequencies (map rank cards))]
(some #(= n (val %)) counts)))
(def pair? (partial n-of-a-kind? 2))
(def three-of-a-kind? (partial n-of-a-kind? 3))
(def four-of-a-kind? (partial n-of-a-kind? 4))
(defn two-pair? [cards]
(let [counts (frequencies (map rank cards))
n-kind (frequencies (vals counts))]
(= (n-kind 2) 2)))
(def full-house? (every-pred pair? three-of-a-kind?))
(defn straight? [cards]
(let [[low & _ :as sorted] (sort (map rank cards))
high-ace (range low (+ low 5))
low-ace [0 1 2 3 12]]
(or (= sorted high-ace) (= sorted low-ace))))
(defn flush? [cards]
(apply = (map second cards)))
(def straight-flush? (every-pred straight? flush?))
(defn royal-flush? [cards]
(and (straight-flush? cards)
(= #{8 9 10 11 12} (set (map rank cards)))))
(def high-card? (constantly true))
(def strength
[#'royal-flush?
#'straight-flush?
#'four-of-a-kind?
#'full-house?
#'flush?
#'straight?
#'three-of-a-kind?
#'two-pair?
#'pair?
#'high-card?])
(defn pred->kw [v]
(let [kw-name (name (symbol v))]
(keyword (.substring kw-name 0 (dec (.length kw-name))))))
(defn poker-hand [cards]
(->> (for [f strength
:when (f cards)]
(pred->kw f))
(first)))
(ns poker
(:require [clojure.set :as set]
[clojure.test :refer [deftest are]]))
;; Card Model
(def cards-in-hand 5)
(def values [:2 :3 :4 :5 :6 :7 :8 :9 :10 :jack :queen :king :ace])
(def suits #{:spades :clubs :hearts :diamonds})
(defn card-value [card]
(first card))
(defn card-suit [card]
(second card))
(defn card? [v]
(and (vector? v)
(= 2 (count v))
(some #(= % (card-value v)) values)
(some #(= % (card-suit v)) suits)))
(defn make-card [[v s]]
(let [value (if (keyword? v)
v
(keyword (str v)))
card [value s]]
(if (card? card)
card)))
(defn build-hand [cards]
(if-let [hand (map make-card cards)]
(if (and (every? card? hand) (= (count hand) cards-in-hand))
hand)))
;; Card Behavior
(defn- ->card-rank [v]
(let [value (if (card? v)
(card-value v)
v)]
(->> (map-indexed (fn [i x] [i x]) values)
(filter #(= value (second %)))
(ffirst))))
(def ->card-rank-memo (memoize ->card-rank))
(defn card-rank-comp [a b]
(compare (->card-rank-memo b) (->card-rank-memo a)))
(defn straights []
(loop [c (->> (cycle values)
(drop (mod -1 (count values)))
(take (inc (count values)))
(into []))
r []]
(if (< (count c) cards-in-hand)
r
(recur (vec (rest c))
(conj r (->> (subvec c 0 cards-in-hand)
(sort card-rank-comp)
(into [])))))))
(def straights-memo (memoize straights))
(defn card-value-frequencies [cards x]
(->> (frequencies (map card-value cards))
(filter (fn [[_ v]] (= x v)))
(map #(filter (fn [c] (= (first %) (card-value c))) cards))))
;; Scoring
(defn ->high-card [cards]
(first (sort card-rank-comp cards)))
(defn ->pair [cards]
(if-let [pairs (card-value-frequencies cards 2)]
(if (= 1 (count pairs)) pairs)))
(defn ->two-pair [cards]
(if-let [pairs (card-value-frequencies cards 2)]
(if (= 2 (count pairs)) pairs)))
(defn ->three-of-a-kind [cards]
(if-let [trio (card-value-frequencies cards 3)]
(if (= 1 (count trio)) trio)))
(defn ->flush [cards]
(and (apply = (map card-suit cards))
cards))
(defn ->straight [cards]
(let [ordered-cards (sort card-rank-comp cards)
ordered-values (mapv card-value ordered-cards)]
(if (some #(= ordered-values %) (straights-memo))
(reverse ordered-cards))))
(defn ->full-house [cards]
(let [trio (first (card-value-frequencies cards 3))
difference (->> (set/difference (set cards) (set trio))
(into []))
pair (first (card-value-frequencies difference 2))]
(if (and (seq trio) (seq pair))
(concat trio pair))))
(defn ->four-of-a-kind [cards]
(if-let [quad (card-value-frequencies cards 4)]
(if (= 1 (count quad)) quad)))
(defn ->straight-flush [cards]
(and (->flush cards)
(->straight cards)))
(defn ->royal-flush [cards]
(and (= :ace (card-value (->high-card cards)))
(->straight-flush cards)))
(def score-rules
[[:royal-flush #'->royal-flush]
[:straight-flush #'->straight-flush]
[:four-of-a-kind #'->four-of-a-kind]
[:full-house #'->full-house]
[:flush #'->flush]
[:straight #'->straight]
[:three-of-a-kind #'->three-of-a-kind]
[:two-pair #'->two-pair]
[:pair #'->pair]
[:high-card #'->high-card]])
(defn score [cards]
(if-let [hand (build-hand cards)]
(some (fn [[k v]] (if (v hand) k)) score-rules)
"Invalid hand"))
;; Tests
(deftest score-test
(are [x y] (= x y)
:royal-flush (score
[[:ace :spades]
[:jack :spades]
[:king :spades]
[:queen :spades]
[10 :spades]])
:straight-flush (score
[[5 :diamonds]
[6 :diamonds]
[4 :diamonds]
[3 :diamonds]
[7 :diamonds]])
:four-of-a-kind (score
[[9 :hearts]
[9 :clubs]
[9 :hearts]
[:queen :spades]
[9 :spades]])
:full-house (score
[[7 :spades]
[:jack :clubs]
[7 :hearts]
[:jack :hearts]
[:jack :diamonds]])
:straight (score
[[:ace :diamonds]
[4 :hearts]
[3 :clubs]
[2 :hearts]
[5 :hearts]])
:flush (score
[[6 :diamonds]
[:queen :diamonds]
[9 :diamonds]
[5 :diamonds]
[8 :diamonds]])
:three-of-a-kind (score
[[10 :clubs]
[10 :spades]
[2 :spades]
[:king :clubs]
[10 :hearts]])
:two-pair (score
[[4 :clubs]
[:queen :clubs]
[:queen :hearts]
[10 :diamonds]
[4 :hearts]])
:pair (score
[[3 :hearts]
[8 :spades]
[:jack :diamonds]
[:queen :diamonds]
[:jack :spades]])
:high-card (score
[[10 :hearts]
[5 :hearts]
[4 :clubs]
[8 :spades]
[2 :diamonds]])
"Invalid hand" (score [[10 :clubs]
[2 :diamonds]
[:jack :hearts]
[:queen :spades]])
"Invalid hand" (score [])))
(defn rank [card]
(first card))
(defn suit [card]
(second card))
(defn flush [hand]
(when (apply = (map suit hand))
:flush))
(defn royal-flush [hand]
(when (and (flush hand)
(= #{:ace :king :queen :jack 10}
(set (map rank hand))))
:royal-flush))
(def rank-order [:ace 2 3 4 5 6 7 8 9 10 :jack :queen :king :ace])
(defn rank-freqs [hand]
(frequencies (map rank hand)))
(defn match-freqs [hand]
(frequencies (vals (rank-freqs hand))))
(def consecutives
(set (map #(set (take 5 (drop % rank-order))) (range 10))))
(defn straight [hand]
(when (contains? consecutives (set (map rank hand)))
:straight))
(defn straight-flush [hand]
(when (and (flush hand)
(straight hand))
:straight-flush))
(defn four-of-a-kind [hand]
(when (contains? (match-freqs hand) 4)
:four-of-a-kind))
(defn pair [hand]
(when (contains? (match-freqs hand) 2)
:pair))
(defn full-house [hand]
(when (and (three-of-a-kind hand)
(pair hand))
:full-house))
(defn three-of-a-kind [hand]
(when (contains? (match-freqs hand) 3)
:three-of-a-kind))
(defn two-pair [hand]
(when (= 2 (get (match-freqs hand) 2))
:two-pair))
(defn high-card [hand]
:high-card)
(def hands-in-order
[royal-flush
straight-flush
four-of-a-kind
full-house
flush
straight
three-of-a-kind
two-pair
pair
high-card])
(defn score [hand]
(->> hands-in-order
(keep #(% hand))
first))
function arrayEqual(a1, a2) {
if(a1.length !== a2.length)
return false;
for(var i = 0; i < a1.length; i++) {
if(a1[i] !== a2[i])
return false;
}
return true;
}
function frequencies(array) {
const ret = {};
array.forEach(v=>{
if(ret[v])
ret[v] += 1;
else
ret[v] = 1;
});
return ret;
}
const rankSeq = ["ace", "king", "queen", "jack", 10, 9, 8, 7, 6, 5, 4, 3, 2, "ace"];
const straights = rankSeq.map((_, i) => rankSeq.slice(i, i+5)).filter(a=>a.length===5).map(a=>a.sort());
function score(hand) {
const allSameSuit = hand.map(c=>c[1]).reduce((a, b) => a === b ? a : false);
const handRanks = hand.map(c=>c[0]).sort();
const hasStraightRank = straights.filter(s=>arrayEqual(s, handRanks)).length>0;
const kindFreqs = frequencies(Object.values(frequencies(handRanks)));
if(allSameSuit &&
arrayEqual(straights[0], handRanks)) return "royal flush";
if(allSameSuit && hasStraightRank) return "straight flush";
if(kindFreqs[4]) return "four of a kind";
if(kindFreqs[3] && kindFreqs[2]) return "full house";
if(allSameSuit) return "flush";
if(hasStraightRank) return "straight";
if(kindFreqs[3]) return "three of a kind";
if(kindFreqs[2] === 2) return "two pair";
if(kindFreqs[2]) return "pair";
return "high card";
}
(ns functional-tv-puzzles.-2020.poker-score-374)
(def suits #{:spades :hearts :diamonds :clubs})
(def royals-ordered [:jack :queen :king :ace])
(def royals (set royals-ordered))
(def numbers (range 2 11))
(def ranks (->> royals (into []) (into numbers)))
(def rank-ordering (->> (into (into [] numbers) royals-ordered)
(map-indexed (fn [i v] [v i]))
(into {})))
(defn rank [card]
(first card))
(defn suit [card]
(last card))
(defn ranking [card]
(rank-ordering (rank card)))
(defn n-group-all
"Returns a partition of cards according to f, ordered by decreasing size"
[cards f]
(->> cards
(group-by f)
vals
(sort-by (comp - count))))
(defn n-group
"Returns the largest group of cards having the same (f card) value"
[cards f]
(first (n-group-all cards f)))
(defn count?
"Returns true iff there are at least n cards"
[n cards]
(<= n (count cards)))
(defn n-group? [n cards f]
(count? n (n-group cards f)))
(defn n-count-group?
"Returns truee iff for each n in ns count? is true for
its respective argument in groups"
[ns groups]
(and (<= (count ns) (count groups))
(every? identity
(map (fn [n cards]
(count? n cards))
ns
groups))))
(defn n-suit
"Returns the largest grouop of cards with the same suit"
[cards]
(n-group cards suit))
(defn n-rank-all [cards]
(n-group-all cards rank))
(defn n-rank
"Returns the largest group of cards with the same rank"
[cards]
(first (n-rank-all cards)))
(defn n-royals
"Returns the largest group of 'royal', and 10-ranked cards"
[cards]
(n-group cards #(if ((conj royals 10) (rank %))
:royal
(rank %))))
(defn consecutive?
"Returns true iff card c2 follows c1 immediately"
[c1 c2]
(= 1 (- (ranking c2) (ranking c1))))
(defn n-consecutive-all
[cards]
(->> cards (sort-by ranking)
(reduce (fn [[[top _ :as part] :as nogaps] c]
(if (and top (consecutive? top c))
(conj nogaps (conj part c))
(conj nogaps (list c))))
())
(sort-by (comp - count))
(map reverse)))
(defn n-consecutive
"Returns the largest group of consecutive cards"
[cards]
(first (n-consecutive-all cards)))
(defn n-pairs
"Returns all groups of pairs, partitioned by rank."
[cards]
(->> cards n-rank-all
(reduce (fn [pairs part]
(if (<= 2 (count part))
(into pairs (partition 2 part))
pairs))
[])))
(defn n-distinct-pairs
"Returns a selection with the largest number of distinct pairs"
[cards]
(->> cards n-pairs
(partition-by #(ranking (first %)))
(map first)))
(defn score [hand]
(let [n-suits (n-suit hand)
n-ranks (n-rank hand)]
(cond
(count? 5 (n-suit (n-royals hand)))
:royal-flush
(count? 5 (n-consecutive (n-suit hand)))
:straight-flush
(count? 4 n-ranks)
:four-of-a-kind
(n-count-group? [3 2] (n-rank-all hand))
:full-house
(count? 5 n-suits)
:flush
(count? 5 (n-consecutive hand))
:straight
(count? 3 n-ranks)
:three-of-a-kind
(count? 2 (n-distinct-pairs hand))
:two-pair
(count? 1 (n-pairs hand))
:pair
:else
:high-card)))
(defn straight? [h]
(let [nvah (merge (zipmap (range 2 11) (range 2 11)) ;; numeric value ace high
{:ace 14 :king 13 :queen 12 :jack 11 :ten 10})
run? #(= % (range (first %) (inc (last %))))
snk (map nvah (map first h))]
(or (run? (sort snk))
(run? (sort (replace {14 1} snk))))))
(defn score [hand]
(let [isflush (apply = (map second hand))
fs (sort (vals (frequencies (map first hand))))]
(cond
(and (straight? hand) isflush
(some #(= :ace %) (map first hand))
(some #(= :king %) (map first hand))) :royal-flush
(and (straight? hand) isflush) :straight-flush
(= '(1 4) fs) :four-of-a-kind
(= '(2 3) fs) :full-house
isflush :flush
(straight? hand) :straight
(= '(1 1 1 2) fs) :pair
(= '(1 1 3) fs) :three-of-a-kind
(= '(1 2 2) fs) :two-pair
:else :high-card)))
(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)
)
(defn score [hand]
(let [same-suit? (apply = (map second hand))
card-ranks (map first hand)
set= (fn [xs ys] (= (set xs) (set ys)))
ranks (into [:ace :king :queen :jack] (range 10 1 -1))
straight-ranks? (some #(set= card-ranks %) (partition 5 1 ranks))
kind-freqs (-> card-ranks frequencies vals frequencies)]
(cond
(and same-suit? (set= card-ranks (take 5 ranks))) :royal-flush
(and same-suit? straight-ranks?) :straight-flush
(kind-freqs 4) :four-of-a-kind
(and (kind-freqs 3) (kind-freqs 2)) :full-house
same-suit? :flush
straight-ranks? :straight
(kind-freqs 3) :three-of-a-kind
(= 2 (kind-freqs 2)) :two-pair
(kind-freqs 2) :pair
:else :high-card)))
(ns purelyfunctional-newsletters.issue-374
(:require [clojure.test :refer :all]))
(defn rank-value [rank]
(condp = rank
:jack 11
:queen 12
:king 13
:ace 14
;; else
rank))
(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 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 consecutives-ranks? [hand]
(let [sorted-ranks (->> (hand-ranks hand)
(map rank-value)
sort)
first-rank (first sorted-ranks)]
(= sorted-ranks
(take (count sorted-ranks) (iterate inc first-rank)))))
(defn straight-flush?
"Straight Flush: Five consecutive cards of the same suit"
[hand]
(and (= 5 (count hand))
(same-suits? hand)
(consecutives-ranks? hand)))
(defn four-of-a-kind?
"Four of a kind: Four cards of the same rank"
[hand]
(->> (hand-ranks hand)
frequencies
(filter (fn [[_ cnt]] (= 4 cnt)))
((comp not empty?))))
(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))
(consecutives-ranks? hand)))
(defn three-of-a-kind?
"Three of a kind: Three cards of the same rank"
[hand]
(->> (group-by-rank hand)
vals
(filter #(>= (count %) 3))
(#(>= (count %) 1))))
(defn two-pairs?
"Two pair: Two different pairs"
[hand]
(->> (group-by-rank hand)
vals
(filter #(>= (count %) 2))
(#(>= (count %) 2))))
(defn pair?
"Pair: Two cards of the same rank"
[hand]
(->> (group-by-rank hand)
vals
(filter #(>= (count %) 2))
(#(>= (count %) 1))))
(defn score [hand]
(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-pairs? hand) :two-pairs
(pair? hand) :pair
:else :high-card))
(deftest score-testing
(testing "examples"
(is (= :three-of-a-kind
(score [[3 :diamonds] [3 :hearts] [3 :spades]
[5 :hearts] [:king :clubs]])))
(is (= :royal-flush
(score [[10 :hearts] [:jack :hearts] [:queen :hearts]
[:ace :hearts] [:king :hearts]])))
(is (= :high-card
(score [[3 :hearts] [5 :hearts] [:queen :spades]
[9 :hearts] [:ace :diamonds]])))
(is (= :four-of-a-kind
(score [[10 :spades] [10 :clubs] [8 :diamonds]
[10 :diamonds] [10 :hearts]])))))
(ns poker-hand-ranking.core
(:require [clojure.math.combinatorics :as math]))
(defn n-of
"Check if there is a n-combination of xs that satisfies pred.
Returns the first satisfied combination, or nil if none is found."
[n xs pred]
(some #(when (pred %) %)
(math/combinations xs n)))
(def four-of #(fn [xs] (n-of 4 xs %)))
(def three-of #(fn [xs] (n-of 3 xs %)))
(def two-of #(fn [xs] (n-of 2 xs %)))
(defn combine-preds
"Returns a predicate that sequentially check if input satisfy all given predicates.
Satisfied elements are removed from input and not available for later predicates.
The predicate returns all unused inputs, or nil if check failed at some point.
Note that the algorithm does not retry even if multiple combinations can satisfy
a predicate, so ordering of predicates may change the result."
[& preds]
(fn [xs]
(reduce (fn [xs pred]
(if-let [comb (pred xs)]
(remove (set comb) xs)
(reduced nil)))
xs
preds)))
(defn same-suit
"Returns true if all cards have the same suit."
[cards]
(apply = (map second cards)))
(defn same-rank
"Returns true if all cards have the same rank."
[cards]
(apply = (map first cards)))
(defn has
"Returns a predicate that check if some of the cards is the given rank."
[rank]
(fn [cards]
(some (partial = rank)
(map first cards))))
(defn consecutive
"Returns true if ranks of the cards are consecutive.
jack = 11, queen = 12, king = 13.
Ace = 1 or 14 depending on the situation."
[cards]
(let [m {:ace (if ((has 2) cards) 1 14)
:jack 11
:queen 12
:king 13}
ranks (map first cards)
numbers (map #(m % %) ranks)
minimum (apply min numbers)
maximum (apply max numbers)]
(= (sort numbers)
(range minimum (inc maximum)))))
(def royal-flush?
(every-pred same-suit
(has :ace)
(has :king)
(has :queen)
(has :jack)
(has 10)))
(def straight-flush?
(every-pred consecutive
same-suit))
(def four-of-a-kind?
(four-of same-rank))
(def full-house?
(combine-preds (three-of same-rank)
(two-of same-rank)))
(def flush?
same-suit)
(def straight?
consecutive)
(def three-of-a-kind?
(three-of same-rank))
(def two-pairs?
(combine-preds (two-of same-rank)
(two-of same-rank)))
(def pair?
(two-of same-rank))
(defn score
"Return the best scoring for a given poker hand of 5 cards."
[cards]
(cond (royal-flush? cards) "Royal 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-pairs? cards) "Two pair"
(pair? cards) "Pair"
:else "High card"))
@steffan-westcott
Copy link

steffan-westcott commented Apr 20, 2020

I forgot that aces can be low in straights e.g. A♣ 2♣ 3♣ 4♣ 5♣. Here's a tweaked version that fixes that:

(defn score [hand]
  (let [same-suit? (apply = (map second hand))
        hand-ranks (map first hand)
        match-hand-ranks? #(= (set hand-ranks) (set %))
        rank-seq (concat [:ace :king :queen :jack] (range 10 1 -1) [:ace])
        straight-ranks? (some match-hand-ranks? (partition 5 1 rank-seq))
        kind-freqs (-> hand-ranks frequencies vals frequencies)]
    (cond
      (and same-suit? (match-hand-ranks? (take 5 rank-seq))) :royal-flush
      (and same-suit? straight-ranks?) :straight-flush
      (kind-freqs 4) :four-of-a-kind
      (and (kind-freqs 3) (kind-freqs 2)) :full-house
      same-suit? :flush
      straight-ranks? :straight
      (kind-freqs 3) :three-of-a-kind
      (= 2 (kind-freqs 2)) :two-pair
      (kind-freqs 2) :pair
      :else :high-card)))

@JonathanHarford
Copy link

As I'm not a poker player, I only learned just now from M. Westcott that aces can be low. Since it wasn't in the specification... I'm going to pretend I didn't see that.

(defn score [unsorted-hand]
  (let [hand           (->> unsorted-hand
                            (mapv (fn [card]
                                    (update card 0 #(case %
                                                      :jack  11
                                                      :queen 12
                                                      :king  13
                                                      :ace   14
                                                      %))))
                            sort)
        flush?         (apply = (mapv second hand))
        straight?      (->> hand
                            (mapv first)
                            (#(= (range (first %) (+ 5 (first %))) %)))
        has-ace?       (-> hand last first (= 14))
        rank-signature (->> hand (mapv first) frequencies vals sort)]
    (cond
      (and flush? straight? has-ace?) :royal-flush
      (and flush? straight?)          :straight-flush
      (= rank-signature [1 4])        :four-of-a-kind
      (= rank-signature [2 3])        :full-house
      flush?                          :flush
      straight?                       :straight
      (= rank-signature [1 1 3])      :three-of-a-kind
      (= rank-signature [1 2 2])      :two-pair
      (= rank-signature [1 1 1 2])    :pair
      :else                           :high-card)))

@KingCode
Copy link

KingCode commented Apr 21, 2020

Hi everyone, in case it helps here is a tentative test-code snippet I used at the bottom of my file.
Please feel free to correct, or to add to it, as I don't know anything about poker other than the challenge spec.
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 [[10 :clubs][:ace :clubs][:queen :clubs][:jack :clubs][:king :clubs]]))
  (testing "Straight Flush"
    (is= :straight-flush [[:jack :hearts][8 :hearts][10 :hearts][7 :hearts] [9 :hearts]]))
  (testing "Four of a Kind"
    (is= :four-of-a-kind [[2 :clubs] [3 :hearts] [2 :diamonds] [2 :spades] [2 :hearts]]))
  (testing "Full House"
    (is= :full-house [[7 :clubs] [4 :hearts] [7 :spades][4 :diamonds] [7 :diamonds]]))
  (isnot= :full-house [[7 :clubs] [7 :hearts] [7 :diamonds] [7 :spade] [2 :hearts]])
  (testing "Flush"
    (is= :flush [[:ace :hearts] [3 :hearts] [4 :hearts] [:jack :hearts] [9 :hearts]]))
  (testing "Straight"
    (is= :straight [[8 :hearts] [4 :hearts] [7 :spades] [5 :clubs] [6 :diamonds]]))
  (testing "Three of a Kind"
    (is= :three-of-a-kind [[:ace :clubs] [4 :hearts] [2 :hearts] [4 :diamonds] [4 :spaces]]))
  (testing "Two Pair"
    (is= :two-pair [[8 :diamonds] [8 :clubs] [:ace :spades] [2 :hearts] [:ace :hearts]])
    (isnot= :two-pair [[8 :diamonds] [8 :clubs] [8 :hearts] [:king :clubs] [8 :spades]]))
  (testing "Pair"
    (is= :pair [[2 :hearts] [2 :clubs] [3 :hearts] [:king :spades] [9 :diamonds]]))
  (testing "High Card"
    (is= :high-card [[:ace :diamonds] [:queen :hearts] [5 :spades] [7 :clubs] [2 :hearts]])))

@steffan-westcott
Copy link

@KingCode The spec mentions that a poker hand here has 5 cards, some of these test cases have other hand sizes.

@KingCode
Copy link

@KingCode The spec mentions that a poker hand here has 5 cards, some of these test cases have other hand sizes.

Thank you @steffan-westcott. I made the correction.

@rmoskal
Copy link

rmoskal commented Apr 27, 2020

I read your email, especially the javascript part. Most js developers would use a library like lodash, ramda, etc that provide a lot of the same functions as the clojure standard library.

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