; Some useful definitions relating to poker hands
(define ranks '(A K Q J 10 9 8 7 6 5 4 3 2))
(define suits '(S H D C))
(define (numeric-rank card)
  (let ((r (rank card)))
    (cond ((equal? r 'a) 14)
          ((equal? r 'k) 13)
          ((equal? r 'q) 12)
          ((equal? r 'j) 11)
          (else r))))

; Constructor and selectors for cards
(define (make-card suit rank)  ;; we never use this, but it shows
  (word suit rank))            ;; how a card is constructed
(define (rank card) (bf card))
(define (suit card) (first card))

; Some previous problem solutions that are kind of nice to have
; for solving some of the poker hand problems
(define (differences sent)
  (cond ((< (count sent) 2) '())
        (else (se (- (item 2 sent) (item 1 sent))
                  (differences (bf sent))))))

(define (consec datum sent)
  (consec-helper datum sent 0 0))
(define (consec-helper datum sent current maximum)
  (cond ((empty? sent) maximum)
        ((equal? (first sent) datum)
         (consec-helper datum (bf sent) (+ current 1) (max (+ current 1) maximum)))
        (else (consec-helper datum (bf sent) 0 maximum))))

; Bubble sort program to put the cards in descending order
(define (sort hand)
  ((repeated sort-once (- (count hand) 1)) hand))
(define (sort-once sent)
  (cond ((empty? sent) sent)
        ((= (count sent) 1) sent)
        ((> (numeric-rank (first sent))
            (numeric-rank (second sent)))
         (se (first sent) (sort-once (bf sent))))
        (else (se (second sent)
                  (sort-once (se (first sent) (bf (bf sent))))))))

; The main program.  NOTE I have not put in the specifics such as
; which suit made a flush or the rank of a pair; I leave that to 
; the reader to complete.
;
; Note also the decision to sort the hand immediately in the poker-value
; function.  I'm cheating a little bit in that this sort permits me to
; avoid sorting in the predicate functions themselves.
(define (poker-value hand)
  (let ((sortedhand (sort hand)))
    (cond ((royal-flush? sortedhand) 'ROYAL)
          ((straight-flush? sortedhand) 'STRAIGHT-FLUSH)
          ((full-house? sortedhand) 'FULL-HOUSE)
          ((quads? sortedhand) 'QUADS)
          ((flush? sortedhand) 'FLUSH)
          ((straight? sortedhand) 'STRAIGHT)
          ((trips? sortedhand) 'TRIPS)
          ((two-pair? sortedhand) 'TWO-PAIR)
          ((one-pair? sortedhand) 'PAIR)
          (else 'GARBAGE))))

; Some hands for testing
;
; Use: (function (sort hand)) where hand is one of the below
(define roy '(s10 sk sq sa sj))  ; royal flush
(define stf '(s10 s8 s9 sj sq))  ; straight flush
(define qua '(s5 h10 h5 c5 d5))  ; quads (four of a kind)
(define fho '(s10 d7 h7 c10 s7)) ; full house (three of one kind, two of another)
(define flu '(sa s10 s7 sk s2))  ; flush
(define str '(d8 dj sq h10 d9))  ; straight
(define tri '(d5 s8 sa s5 c5))   ; trips
(define 2pr '(d7 s9 c7 sa h9))   ; two pair
(define 1pr '(d7 s9 c10 sa h9))  ; one pair
(define gbg '(d10 s9 c2 sa h5))  ; garbage