8
\$\begingroup\$

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))))
\$\endgroup\$
3
\$\begingroup\$

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)))
\$\endgroup\$
  • \$\begingroup\$ Very inspiring, great input! Thank you for sharing your experience. \$\endgroup\$ – Martin Buchmann Nov 12 '17 at 6:37

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.