|
(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])))) |
Here are my tests for the new score function: could someone please let me know if anything is wrong? Thanks!