Poker Hand Scoring in Clojure

gistfile1.txt

(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"}