Maximum PC

// perform a binary search on a pre-sorted array
int findit( int key )

//   This routine initializes the deck.  A deck of cards is
//   simply an integer array of length 52 (no jokers).  This
//   array is populated with each card, using the following
//   scheme:
//
//   An integer is made up of four bytes.  The high-order
//   bytes are used to hold the rank bit pattern, whereas
//   the low-order bytes hold the suit/rank/prime value
//   of the card.
//
//   +--------+--------+--------+--------+
//   |xxxbbbbb|bbbbbbbb|cdhsrrrr|xxpppppp|
//   +--------+--------+--------+--------+
//
//   p = prime number of rank (deuce=2,trey=3,four=5,five=7,...,ace=41)
//   r = rank of card (deuce=0,trey=1,four=2,five=3,...,ace=12)
//   cdhs = suit of card
//   b = bit turned on depending on rank of card
init_deck( int *deck )
{
    int i, j, n = 0, suit = 0x8000;

    for ( i = 0; i < 4; i++, suit >>= 1 )
        for ( j = 0; j < 13; j++, n++ )
            deck[n] = primes[j] | (j << 8) | suit | (1 << (16+j));
}

//  This routine will search a deck for a specific card
//  (specified by rank/suit), and return the INDEX giving
//  the position of the found card.  If it is not found,
//  then it returns -1
int find_card( int rank, int suit, int *deck )


//  This routine takes a deck and randomly mixes up
//  the order of the cards.
shuffle_deck( int *deck )

print_hand( int *hand, int n )

int hand_rank( short val )
{
    if (val > 6185) return(HIGH_CARD);        // 1277 high card
    if (val > 3325) return(ONE_PAIR);         // 2860 one pair
    if (val > 2467) return(TWO_PAIR);         //  858 two pair
    if (val > 1609) return(THREE_OF_A_KIND);  //  858 three-kind
    if (val > 1599) return(STRAIGHT);         //   10 straights
    if (val > 322)  return(FLUSH);            // 1277 flushes
    if (val > 166)  return(FULL_HOUSE);       //  156 full house
    if (val > 10)   return(FOUR_OF_A_KIND);   //  156 four-kind
    return(STRAIGHT_FLUSH);                   //   10 straight-flushes
}

short eval_5cards( int c1, int c2, int c3, int c4, int c5 )

short eval_5hand( int *hand )

// This is a non-optimized method of determining the
// best five-card hand possible out of seven cards.
// I am working on a faster algorithm.
short eval_7hand( int *hand )

;;   This routine initializes the deck.  A deck of cards is
;;   simply an integer array of length 52 (no jokers).  This
;;   array is populated with each card, using the following
;;   scheme:
;;
;;   An integer is made up of four bytes.  The high-order
;;   bytes are used to hold the rank bit pattern, whereas
;;   the low-order bytes hold the suit/rank/prime value
;;   of the card.
;;
;;   +--------+--------+--------+--------
;;   |xxxbbbbb|bbbbbbbb|cdhsrrrr|xxpppppp|
;;   +--------+--------+--------+--------+
;;
;;   p = prime number of rank (deuce=2,trey=3,four=5,five=7,...,ace=41)
;;   r = rank of card (deuce=0,trey=1,four=2,five=3,...,ace=12)
;;   cdhs = suit of card
;;   b = bit turned on depending on rank of card
;;
(defun init-deck (deck)
  (let ((deck '()))
    (dotimes (suit 4)
      (dotimes (rank 13)
        (push (get-card-vector suit rank) deck)))
    (nreverse deck)))

(defun get-card-vector (suit rank)
  ;;bit selectors for accessing the bits in the diagram above
  ;;and a list containing the prime numbers used for the hashing
  (let ((rank-sel (byte 4 8))
   (suit-start-bit 12)
   (b-start-bit 16)
   (primes (list 2 3 5 7 11 13 17 19 23 29 31 37 41)))
    (dpb 1 (byte 1 (+ b-start-bit rank))             ;set the b bit
      (dpb 1 (byte 1 (+ suit-start-bit suit))     ;set the suit bit
            (dpb rank rank-sel                     ;set the rank bits
         (nth rank primes))))))            ;select the prime hash

;;utility function for checking the bit vectors...
(defun print-card-as-32bit-vector (card)
  (format t "~32b~%" card))

(defun print-test-cases ()
  (let ((msg "A couple of test cases from the Cactus Kev website:")
   (bit-pattern "xxxbbbbbbbbbbbbbcdhsrrrrxxpppppp")
        (t1 "00001000000000000100101100100101    King of Diamonds")
        (t2 "00000000000010000001001100000111    Five of Spades")
   (t3 "00000010000000001000100100011101    Jack of Clubs"))
    (format t "~a~2%~a~%~a~%" msg bit-pattern t1)
    (print-card-as-32bit-vector (get-card-vector 2 11)) 
    (format t "~%~a~%~a~%" bit-pattern t2)   
    (print-card-as-32bit-vector (get-card-vector 0 3)) 
    (format t "~%~a~%~a~%" bit-pattern t3)
    (print-card-as-32bit-vector (get-card-vector 3 9))))

(defun hand-rank (val)
  (cond ((> val 6185) 'high-card) 
   ((> val 3325) 'ONE-PAIR)
   ((> val 2467) 'TWO-PAIR)
   ((> val 1609) 'THREE-OF-A-KIND)
   ((> val 1599) 'STRAIGHT)
   ((> val 322)  'FLUSH)
   ((> val 166)  'FULL-HOUSE)
   ((> val 10)   'FOUR-OF-A-KIND)
   (t            'STRAIGHT-FLUSH)))

(defun hand-rank-tests ()
  (let ((test-values '(7000 4000 3000 1700 1607 400 200 44 4))
   (exp-return-values '(high-card ONE-PAIR TWO-PAIR THREE-OF-A-KIND STRAIGHT
              FLUSH FULL-HOUSE FOUR-OF-A-KIND STRAIGHT-FLUSH)))
    (dotimes (i 9)
      (format t "test #~a  exp: ~a  act: ~a~%"
         (1+ i) (nth i exp-return-values) (hand-rank (nth i test-values))))))

;;This routine takes a deck and randomly mixes up
;;the order of the cards.
(defun shuffle (list)
  (let ((len (length list)))
    (loop for i from 0 to (1- len)
     do (rotatef (elt list i) (elt list (random len)))))
  list)

CL-USER> (load "../lisp code/pokerlib-c.lisp")
;; Loading file ..\lisp code\pokerlib-c.lisp ...
;; Loaded file ..\lisp code\pokerlib-c.lisp
T
CL-USER> (print-test-cases)
A couple of test cases from the Cactus Kev website:

xxxbbbbbbbbbbbbbcdhsrrrrxxpppppp
00001000000000000100101100100101    King of Diamonds
    1000000000000100101100100101

xxxbbbbbbbbbbbbbcdhsrrrrxxpppppp
00000000000010000001001100000111    Five of Spades
            10000001001100000111

xxxbbbbbbbbbbbbbcdhsrrrrxxpppppp
00000010000000001000100100011101    Jack of Clubs
      10000000001000100100011101
NIL
CL-USER> (hand-rank-tests)
test #1  exp: HIGH-CARD  act: HIGH-CARD
test #2  exp: ONE-PAIR  act: ONE-PAIR
test #3  exp: TWO-PAIR  act: TWO-PAIR
test #4  exp: THREE-OF-A-KIND  act: THREE-OF-A-KIND
test #5  exp: STRAIGHT  act: STRAIGHT
test #6  exp: FLUSH  act: FLUSH
test #7  exp: FULL-HOUSE  act: FULL-HOUSE
test #8  exp: FOUR-OF-A-KIND  act: FOUR-OF-A-KIND
test #9  exp: STRAIGHT-FLUSH  act: STRAIGHT-FLUSH
NIL
CL-USER>