🎉 Exercism Research is now launched. Help Exercism, help science and have some fun at research.exercism.io 🎉
Avatar of razum2um

razum2um's solution

to Poker in the Clojure Track

Published at Jul 24 2018 · 0 comments
Instructions
Test suite
Solution

Pick the best hand(s) from a list of poker hands.

See wikipedia for an overview of poker hands.

Source

Inspired by the training course from Udacity. https://www.udacity.com/course/viewer#!/c-cs212/

Submitting Incomplete Solutions

It's possible to submit an incomplete solution so you can see how others have completed the exercise.

poker_test.clj

(ns poker-test
  (:require [clojure.test :refer [deftest is]]
            [poker :refer [best-hands]]))

(defn f [xs ys] (= (sort (best-hands xs)) (sort ys)))

(deftest single-hand-always-wins
  (is (f ["4S 5S 7H 8D JC"] ["4S 5S 7H 8D JC"])))

(deftest highest-card-out-of-all-hands-wins
  (is (f ["4D 5S 6S 8D 3C"
          "2S 4C 7S 9H 10H"
          "3S 4S 5D 6H JH"]
         ["3S 4S 5D 6H JH"])))

(deftest a-tie-has-multiple-winners
  (is (f ["4D 5S 6S 8D 3C"
          "2S 4C 7S 9H 10H"
          "3S 4S 5D 6H JH"
          "3H 4H 5C 6C JD"]
         ["3S 4S 5D 6H JH"
          "3H 4H 5C 6C JD"])))

(deftest multiple-hands-with-the-same-high-cards-tie-compares-next-highest-ranked-down-to-last-card
  (is (f ["3S 5H 6S 8D 7H"
          "2S 5D 6D 8C 7S"]
         ["3S 5H 6S 8D 7H"])))

(deftest one-pair-beats-high-card
  (is (f ["4S 5H 6C 8D KH"
          "2S 4H 6S 4D JH"]
         ["2S 4H 6S 4D JH"])))

(deftest highest-pair-wins
  (is (f ["4S 2H 6S 2D JH"
          "2S 4H 6C 4D JD"]
         ["2S 4H 6C 4D JD"])))

(deftest two-pairs-beats-one-pair
  (is (f ["2S 8H 6S 8D JH"
          "4S 5H 4C 8C 5C"]
         ["4S 5H 4C 8C 5C"])))

(deftest both-hands-have-two-pairs-highest-ranked-pair-wins
  (is (f ["2S 8H 2D 8D 3H"
          "4S 5H 4C 8S 5D"]
         ["2S 8H 2D 8D 3H"])))

(deftest both-hands-have-two-pairs-with-the-same-highest-ranked-pair-tie-goes-to-low-pair
  (is (f ["2S QS 2C QD JH"
          "JD QH JS 8D QC"]
         ["JD QH JS 8D QC"])))

(deftest both-hands-have-two-identically-ranked-pairs-tie-goes-to-remaining-card-kicker
  (is (f ["JD QH JS 8D QC"
          "JS QS JC 2D QD"]
         ["JD QH JS 8D QC"])))

(deftest three-of-a-kind-beats-two-pair
  (is (f ["2S 8H 2H 8D JH"
          "4S 5H 4C 8S 4H"]
         ["4S 5H 4C 8S 4H"])))

(deftest both-hands-have-three-of-a-kind-tie-goes-to-highest-ranked-triplet
  (is (f ["2S 2H 2C 8D JH"
          "4S AH AS 8C AD"]
         ["4S AH AS 8C AD"])))

(deftest with-multiple-decks-two-players-can-have-same-three-of-a-kind-ties-go-to-highest-remaining-cards
  (is (f ["4S AH AS 7C AD"
          "4S AH AS 8C AD"]
         ["4S AH AS 8C AD"])))

(deftest a-straight-beats-three-of-a-kind
  (is (f ["4S 5H 4C 8D 4H"
          "3S 4D 2S 6D 5C"]
         ["3S 4D 2S 6D 5C"])))

(deftest aces-can-end-a-straight-10-J-Q-K-A
  (is (f ["4S 5H 4C 8D 4H"
          "10D JH QS KD AC"]
         ["10D JH QS KD AC"])))

(deftest aces-can-start-a-straight-A-2-3-4-5
  (is (f ["4S 5H 4C 8D 4H"
          "4D AH 3S 2D 5C"]
         ["4D AH 3S 2D 5C"])))

(deftest both-hands-with-a-straight-tie-goes-to-highest-ranked-card
  (is (f ["4S 6C 7S 8D 5H"
          "5S 7H 8S 9D 6H"]
         ["5S 7H 8S 9D 6H"])))

(deftest even-though-an-ace-is-usually-high-a-5-high-straight-is-the-lowest-scoring-straight
  (is (f ["2H 3C 4D 5D 6H"
          "4S AH 3S 2D 5H"]
         ["2H 3C 4D 5D 6H"])))

(deftest flush-beats-a-straight
  (is (f ["4C 6H 7D 8D 5H"
          "2S 4S 5S 6S 7S"]
         ["2S 4S 5S 6S 7S"])))

(deftest both-hands-have-a-flush-tie-goes-to-high-card-down-to-the-last-one-if-necessary
  (is (f ["4H 7H 8H 9H 6H"
          "2S 4S 5S 6S 7S"]
         ["4H 7H 8H 9H 6H"])))

(deftest full-house-beats-a-flush
  (is (f ["3H 6H 7H 8H 5H"
          "4S 5H 4C 5D 4H"]
         ["4S 5H 4C 5D 4H"])))

(deftest both-hands-have-a-full-house-tie-goes-to-highest-ranked-triplet
  (is (f ["4H 4S 4D 9S 9D"
          "5H 5S 5D 8S 8D"]
         ["5H 5S 5D 8S 8D"])))

(deftest with-multiple-decks-both-hands-have-a-full-house-with-the-same-triplet-tie-goes-to-the-pair
  (is (f ["5H 5S 5D 9S 9D"
          "5H 5S 5D 8S 8D"]
         ["5H 5S 5D 9S 9D"])))

(deftest four-of-a-kind-beats-a-full-house
  (is (f ["4S 5H 4D 5D 4H"
          "3S 3H 2S 3D 3C"]
         ["3S 3H 2S 3D 3C"])))

(deftest both-hands-have-four-of-a-kind-tie-goes-to-high-quad
  (is (f ["2S 2H 2C 8D 2D"
          "4S 5H 5S 5D 5C"]
         ["4S 5H 5S 5D 5C"])))

(deftest with-multiple-decks-both-hands-with-identical-four-of-a-kind-tie-determined-by-kicker
  (is (f ["3S 3H 2S 3D 3C"
          "3S 3H 4S 3D 3C"]
         ["3S 3H 4S 3D 3C"])))

(deftest straight-flush-beats-four-of-a-kind
  (is (f ["4S 5H 5S 5D 5C"
          "7S 8S 9S 6S 10S"]
         ["7S 8S 9S 6S 10S"])))

(deftest both-hands-have-straight-flush-tie-goes-to-highest-ranked-card
  (is (f ["4H 6H 7H 8H 5H"
          "5S 7S 8S 9S 6S"]
         ["5S 7S 8S 9S 6S"])))
(ns poker
  (:refer-clojure :exclude [flush]))

(defmacro defcombination [name value] `(def ~name [~value ~(keyword name)]))
(defcombination straight-flush 8)
(defcombination four-of-kind 7)
(defcombination full-house 6)
(defcombination flush 5)
(defcombination straight 4)
(defcombination three-of-kind 3)
(defcombination two-pair 2)
(defcombination pair 1)
(defcombination one-card 0)

(defrecord Card [value suit])

(defn value->int [s]
  {:pre [(or (re-find #"^[0-9]{1,2}$" s) (re-find #"^[JQKA]$" s))]}
  (case s
    "J" 11
    "Q" 12
    "K" 13
    "A" 14
    (Integer/parseInt s)))

(defn make-Card [s]
  (let [str-value (subs s 0 (dec (count s)))]
    (->Card (value->int str-value) (last s))))

;; getters

(defn same-suit? [hand] (->> hand (map :suit) set count (= 1)))

(defn usual-straight? [hand]
  (let [[least & vals] (->> hand (map :value) sort)
        relative-vals (map #(- % least) vals)]
    (= '(1 2 3 4) relative-vals)))

(defn low-rank-ace-straight? [hand]
  (= '(2 3 4 5 14) (->> hand (map :value) sort)))

(defn straight? [hand] (or (usual-straight? hand) (low-rank-ace-straight? hand)))

(defn n-of-kind? [n hand]
  (some->> hand
           (group-by :value)
           (filter #(-> % val count (= n)))
           (sort-by key)
           last
           vec))

(defn max-value [hand]
  (if (low-rank-ace-straight? hand)
    5
    (->> hand (map :value) (apply max))))

;; cast hand to weight-able combination

(defn ->straight-flush [hand]
  (when (and (same-suit? hand) (straight? hand))
    [straight-flush [(max-value hand)]]))

(defn ->four-of-kind [hand]
  (when-let [[value-of-kind _] (n-of-kind? 4 hand)]
    [four-of-kind [value-of-kind]]))

(defn ->full-house [hand]
  (when-let [[value-of-three cards] (n-of-kind? 3 hand)]
    (let [three? (set cards)
          hand-without-three (remove three? hand)]
      (when-let [[value-of-two _] (n-of-kind? 2 hand-without-three)]
        [full-house [value-of-three value-of-two]]))))

(defn ->flush [hand]
  (when (same-suit? hand)
    [flush [(max-value hand)]]))

(defn ->straight [hand]
  (when (straight? hand)
    [straight [(max-value hand)]]))

(defn ->three-of-kind [hand]
  (when-let [[value-of-three _] (n-of-kind? 3 hand)]
    [three-of-kind [value-of-three]]))

(defn ->two-pair [hand]
  (when-let [[value-of-two cards] (n-of-kind? 2 hand)]
    (let [another-pair? (set cards)
          hand-without-pair (remove another-pair? hand)]
      (when-let [[another-value-of-two & _] (n-of-kind? 2 hand-without-pair)]
        (let [sorted-pair-values (-> [value-of-two another-value-of-two] sort reverse vec)]
          [two-pair sorted-pair-values])))))

(defn ->pair [hand]
  (when-let [[value-of-two _] (n-of-kind? 2 hand)]
    [pair [value-of-two]]))

(defn ->one-card [hand]
  [one-card [(max-value hand)]])

;; poker

(defn ->hand [s] (map make-Card (clojure.string/split s #" ")))

(defn combination
  "Returns hand with prefix denoting determined combination such that it's sortable be weight
  where weight = [sortable-combination maximum-card-values]

  (combination \"5S 7S 8S 9S 6S\") ;;=> [[[8 :straight-flush] [9]]]
  (combination \"4S 5H 5S 5D 5C\") ;;=> [[7 :four-of-kind] [5]]
  (combination \"5H 5S 5D 9S 9D\") ;;=> [[6 :full-house] [5 9]]
  (combination \"2S 4S 5S 6S 7S\") ;;=> [[5 :flush] [7]]
  (combination \"3S 4D 2S 6D 5C\") ;;=> [[4 :straight] [6]]
  (combination \"4D AH 3S 2D 5C\") ;;=> [[4 :straight] [5]] ;; ace as 1
  (combination \"4S 5H 4C 8S 4H\") ;;=> [[3 :three-of-kind] [4]]
  (combination \"2S 8H 2H 8D JH\") ;;=> [[2 :two-pair] [8 2]]
  (combination \"2S 8H 6S 8D JH\") ;;=> [[1 :pair] [8]]"
  [v]
  (let [hand (->hand v)]
    ((some-fn ->straight-flush
              ->four-of-kind
              ->full-house
              ->flush
              ->straight
              ->three-of-kind
              ->two-pair
              ->pair
              ->one-card) hand)))

(defn combination-with-kicker
  "Adds to weight highest-first sorted card values"
  [v]
  (conj (combination v) (->> v ->hand (map :value) sort reverse vec)))

(defn best-hands [hands]
  (some->> hands
           (group-by combination-with-kicker)
           (sort-by key)
           reverse
           first
           val))

Community comments

Find this solution interesting? Ask the author a question to learn more.

What can you learn from this solution?

A huge amount can be learned from reading other people’s code. This is why we wanted to give exercism users the option of making their solutions public.

Here are some questions to help you reflect on this solution and learn the most from it.

  • What compromises have been made?
  • Are there new concepts here that you could read more about to improve your understanding?