# Scoring poker hands

Just for fun I solved another Project Euler problem dealing with poker cards. I think it is also part of other programming puzzles which can be found in the web. While there is not much mathematics in it, I had some problems to find a good solution with respect to data representation, initially. Because this is a one-time program and the input data comes from a file as strings, I used strings to store the information about the cards.

Writing the code was pretty much a straight forward tasks but there are some spots, where I would like to ask for your comments in respect to code readability, style and efficiency. My code uses alexandria and split-sequence libraries.

;;; The ranks of the cards in a poker-game
(defparameter +poker-ranks+ "23456789TJQKA"
"The ranks of the cards in a poker-game")

;;; The suits of the cards in a poker game
;;; clubs (♣), diamonds (♦), hearts (♥) and spades (♠)
(defparameter +poker-suits+ "cdhs"
"The suits of the cards in a poker game")

;;; The values of the cards
(defparameter +poker-values+ (alexandria:iota 13 :start 2)
"The values of the cards")

;;; A card is represented by a two character string consisting of the rank and
;;; the suit.
(defun card-rank (card)
"Returns the value of CARD."
(aref card 0))

(defun card-suit (card)
"Returns the suit of CARD."
(aref card 1))

(defun value-of-card (card)
"Returns the numerical value of CARD."
(nth (position (card-rank card) +poker-ranks+)
+poker-values+))

(defun sort-hand (hand)
"Returns HAND in ascending order."
(sort (copy-list hand) #'< :key #'value-of-card))

;;; The possible patterns in a poker hand.
(defparameter straights (append (mapcar (lambda (x) (list x (1- x) (- x 2) (- x 3) (- x 4)))
(alexandria:iota 9 :start 14 :step -1)) '((14 5 4 3 2))))
(defparameter ranks '((1 1 1 1 1) (2 1 1 1) (2 2 1) (3 1 1) () () (3 2) (4 1)))

(defun hand-pattern (hand)
"Returns a list with the pattern of HAND."
(loop :for card :in (sort-hand hand)
:with pattern = (loop :for i :upto 12 :collect 0)
:do (incf (nth (position (card-rank card) +poker-ranks+) pattern))
:finally (return (sort (loop :for i in pattern :if (not (zerop i)) :collect i) #'>))))

(defun hand-values (hand)
"Returns a list with the sorted values of HAND."
(let ((frequency (make-hash-table)))
(loop :for i :from 2 :upto 14
:do (setf (gethash i frequency) 0))
(loop :for card :in (sort-hand hand)
:for value = (value-of-card card)
:with result = '()
:do (pushnew value result)
(incf (gethash value frequency))
:finally (return (sort result #'> :key (lambda (x) (gethash x frequency)))))))

(defun flush-p (hand)
"Returns T if all cards of HAND have the same suit."
(labels ((equal-suit-p (list-of-suits)
(cond
((endp (rest list-of-suits)) T)
((char= (first list-of-suits) (second list-of-suits))
(equal-suit-p (rest list-of-suits)))
(t nil))))
(equal-suit-p (mapcar 'card-suit hand))))

(defun score-hand (hand)
"Returns the score of HAND as a list of two lists representing the rank and
the values of the cards."
(let ((score     (position (hand-pattern hand) ranks :test #'equal))
(straight? (position (hand-values hand) straights :test #'equal)))
(cond
((and (= 0 score)                 ; Royal Flush
straight?
(= 0 straight?)
(flush-p hand))
(setf score 9)
(cons score (list (hand-values hand))))
((and (= 0 score)                 ; Straight Flush
straight?
(flush-p hand))
(setf score 8)
(cons score (list (hand-values hand))))
((and (= 0 score) (flush-p hand)) ; Flush
(setf score 5)
(cons score (list (hand-values hand))))
((and (= 0 score)                 ; Straight
straight?)
(setf score 4)
(cons score (list (hand-values hand))))
(t (cons score (list (hand-values hand)))))))

(defun win-poker-p (hand-1 hand-2)
"Returns T if HAND-1 wins over HAND-2."
(let ((score-1 (score-hand hand-1))
(score-2 (score-hand hand-2))
(value-1 (hand-values hand-1))
(value-2 (hand-values hand-2)))
(cond ((> (first score-1) (first score-2)) T) ; Player 1 wins
((< (first score-1) (first score-2)) nil) ; Player 2 wins
(t (loop :for c1 :in value-1 ; Checking the values
:for c2 :in value-2
:when (> c1 c2) :do (return T)
:when (< c1 c2) :do (return nil))))))

;;; A game is a string of ten cards.
;;; A hand is a list of five strings.
;;; "8C TS KC 9H 4S 7D 2S 5D 3S AC"
;;; ("8C" "TS" "KC" "9H" "4S") ("7D" "2S" "5D" "3S" "AC")
(defun split-hands (game-string)
"Returns a list of two lists containing two hands of a poker game given by GAME-STRING."
(loop :for card :in (split-sequence #\Space game-string)
:for n :from 1
:if (< n 6)
:collect card :into hand-1
:else
:collect card :into hand-2
:finally (return (list hand-1 hand-2))))

Some remarks:

&aux variables can reduce the indentation level.

Here we can also get rid of the with & finally clauses. Matter of taste.

Notice that we can give the default value to GETHASH -> no need to initialize the hash-table.

(defun hand-values (hand &aux result (frequency (make-hash-table)))
"Returns a list with the sorted values of HAND."
(loop :for card :in (sort-hand hand)
:for value = (value-of-card card)
:do (pushnew value result)
(incf (gethash value frequency 0)))
(sort result #'> :key (lambda (x) (gethash x frequency))))

Writing a recursive function is usually a code smell: probably a function already exists which gets rid of the recursion. Here we have several possibilities. We could use every. Here I use remove-duplicates. If all cards have the same suit, they would be all duplicates and only one is left.

(defun flush-p (hand)
"Returns T if all cards of HAND have the same suit."
(= 1 (length (remove-duplicates hand :key #'card-suit))))

Next we reduce redundant computations. We also return multiple values instead of a list of values.

(defun score-hand (hand &aux (hand-values (hand-values hand)))
"Returns the score of HAND as two values representing the rank and
the values of the cards."
(let ((score     (position (hand-pattern hand) ranks     :test #'equal))
(straight? (position hand-values         straights :test #'equal)))
(values (cond ((and (= 0 score)                 ; Royal Flush
straight?
(= 0 straight?)
(flush-p hand))
9)
((and (= 0 score)                 ; Straight Flush
straight?
(flush-p hand))
8)
((and (= 0 score) (flush-p hand)) ; flush-p
5)
((and (= 0 score)                 ; Straight
straight?)
4)
(t
score))
hand-values)))

Next we use the multiple values coming from SCORE-HAND. Notice also that the score values are actually single numbers.

We also rename the function to winner, since it returns the winner as a symbolic value. Using a predicate seems to be less clear.

(defun winner (hand-1 hand-2 &aux score-1 score-2 value-1 value-2)
"Returns :HAND-1 or :HAND-2."
(setf (values score-1 value-1) (score-hand hand-1)
(values score-2 value-2) (score-hand hand-2))
(cond ((> score-1 score-2) :hand-1)
((< score-1 score-2) :hand-2)
(t (loop :for c1 :in value-1   ; Checking the values
:for c2 :in value-2
:when (> c1 c2) :do (return :hand-1)
:when (< c1 c2) :do (return :hand-2)))))

Here no LOOP is needed. We check the length of the game and split it with subseq. The lists are returned as two values.

(defun split-hands (game-string &aux (game (split-sequence #\space game-string)))
"Returns two lists containing two hands of a poker game given by GAME-STRING.
A game-string is a string of ten cards separated by space."
(assert (= 10 (length game)) (game))
(values (subseq game 0 5)
(subseq game 5)))
• Very inspiring, great input! Thank you for sharing your experience. Nov 12, 2017 at 6:37