Programming Praxis

This exercise is harder than it looks. We begin with the code to rank hands. A card is represented as a two-character string, with pips in the first character and suit in the second. The four possible suits are #\S spades, #\H hearts, #\C clubs and #\D diamonds. For pips, digits represent themselves, with #\T ten, #\J jack, #\Q queen, #\K king, and #\A ace. For instance, "AH" is the ace of hearts. The functions below identify the pips and suit:

(define pips
  (let ((ps (map cons (map char-upcase
          (string->list "23456789TJQKA")) (range 2 15))))
    (lambda (card)
      (cdr (assoc (char-upcase (string-ref card 0)) ps)))))

(define (suit card) (char-upcase (string-ref card 1)))

A flush has all five suits the same:

(define (flush? hand) (apply char=? (map suit hand)))

There are two kinds of straights, with ace high and ace low; straight returns the number of the highest-ranking card in a hand, or #f if no straight is present:

(define (straight cs)
  (cond ((equal? cs '(14 5 4 3 2)) 5)
        ((apply = 1 (map - (take 4 cs) (cdr cs))) (car cs))
        (else #f)))

The same function looks for n cards with the same rank; it returns the rank, or #f if the hand does not contain n cards of the same rank:

(define (same n cards)
  (let ((len (length cards)))
    (let loop ((i 0) (cards cards))
      (cond ((negative? (- len n i)) #f)
            ((apply = (take n cards)) (car cards))
            (else (loop (+ i 1) (cdr cards)))))))

Now we can look at the code to rank a hand. Rank returns a list of numbers. The first number is the type of hand, ranging from 9 for a straight flush to 1 for a high card. The remaining numbers are tie-breakers, from highest to lowest. Note the difference between a hand (a list of five cards) and a list of cards (a list of five pips, sorted in descending order):

(define (rank hand)
  (let ((cards (sort > (map pips hand))))
    (cond ((straight cards) =>
            (lambda (c)
              (if (flush? hand)
                  (list 9 c)
                  (list 5 c))))
          ((flush? hand) (cons 6 cards))
          ((same 4 cards) =>
            (lambda (c)
              (list 8 c (car (remove c cards)))))
          ((same 3 cards) =>
            (lambda (c)
              (let* ((cs (remove c cards))
                     (k (same 2 cs)))
                (if k (list 7 c k) (cons* 4 c cs)))))
          ((same 2 cards) =>
            (lambda (c)
              (let* ((cs (remove c cards))
                     (k (same 2 cs)))
                (if k (list 3 c k (car (remove k cs)))
                      (cons* 2 c cs)))))
          (else (cons 1 cards)))))

The order of the cond clauses is significant. The first clause identifies straights and straight flushes. The second clause identifies flushes. The next three clauses identify quads, trips and pairs; the trips clause also looks for full houses, and the pairs clause also looks for two pairs. The final clause catches anything else. The rank function is complicated enough to deserve a test:

(define (test-rank)
  (assert (rank '("AH" "KH" "QH" "JH" "TH")) '(9 14))
  (assert (rank '("7H" "7C" "3H" "7S" "7D")) '(8 7 3))
  (assert (rank '("TH" "JC" "TS" "JD" "TC")) '(7 10 11))
  (assert (rank '("4H" "7H" "AH" "KH" "9H")) '(6 14 13 9 7 4))
  (assert (rank '("AH" "2C" "3S" "4D" "5H")) '(5 5))
  (assert (rank '("9C" "4S" "KD" "9D" "9H")) '(4 9 13 4))
  (assert (rank '("6D" "6C" "8H" "TD" "8D")) '(3 8 6 10))
  (assert (rank '("9C" "3S" "4D" "7C" "3D")) '(2 3 9 7 4))
  (assert (rank '("4C" "KD" "8S" "6D" "2D")) '(1 13 8 6 4 2)))

Two hands are compared by running through the lists returned by rank; the first point of mis-match determines the winner:

(define (lt? hand1 hand2)
  (let loop ((h1 (rank hand1)) (h2 (rank hand2)))
    (cond ((or (null? h1) (null? h2)) #f)
          ((< (car h1) (car h2)) #t)
          ((< (car h2) (car h1)) #f)
          (else (loop (cdr h1) (cdr h2))))))

Now we return to the original problem. Here is a function that enumerates all combinations of n items taken from a list; it’s simple and elegant, and dates to the folklore of computing. We use combs to generate all possible five-card hands from a list of seven cards:

(define (combs n xs)
  (cond ((zero? n) '(()))
        ((null? xs) '())
        (else (append (map (lambda (c) (cons (car xs) c))
                           (combs (- n 1) (cdr xs)))
                      (combs n (cdr xs))))))

To find the best hand, loop through all the possibilities:

(define (best-hand cards)
  (let ((hands (combs 5 cards)))
    (let loop ((best (car hands)) (hands (cdr hands)))
      (cond ((null? hands) best)
            ((lt? best (car hands))
              (loop (car hands) (cdr hands)))
            (else (loop best (cdr hands)))))))

Here’s an example, two pairs of aces and eights, the “dead man’s hand” held in a game of five-card draw by Wild Bill Hickock at the time of his murder:

> (best-hand '("AC" "JD" "8S" "8C" "AS" "3D" "4D"))
("AC" "JD" "8S" "8C" "AS")

We used take, drop, range, cons*, remove, sort and assert from the Standard Prelude. You can run the code at http://programmingpraxis.codepad.org/tdgaPIju.

Pages: 1 2