;;; cards.scm
;;; Some scheme functions that create and manipulate playing cards.
;;;
;;; Copyright (c) Robert R. Snapp 2003.

;; card is a data structure that holds a playing card.
(define-struct card (rank suit))

;; display-cards : card -> list
;;               : nested list of cards -> nested list of lists
(define (display-cards c)
  (cond [(card? c) (list (card-rank c) (card-suit c))]
        [(list? c) (map display-cards c)]
        [else (error 'display-cards 
                     "Argument must be a card or a nested list of cards.")]))

;; Some symbolic definitions
(define standard-ranks '(A 2 3 4 5 6 7 8 9 10 J Q K))
(define standard-suits '(S H D C))        ; Spades, Hearts, Diamonds, Clubs.
(define joker (make-card 'joker 'joker))  ; N.B. Both the rank and suit are set to 'joker.

;;; Functions that create new things

;; make-standard-deck: -> list
;; Generates a list of the 52 standard playing cards. 
(define (make-standard-deck)
  (append (make-suit 'S standard-ranks)   ; generate a list of the 13 spades cards
          (make-suit 'H standard-ranks)   ; generate a list of the 13 hearts
          (make-suit 'D standard-ranks)   ; generate a list of the 13 diamonds
          (make-suit 'C standard-ranks))) ; generate a list of the 13 clubs

;; make-suit : symbol list -> list
;; Generates a list of playing cards in the indicated suit (first argument) 
;; for all card ranks specified in the second argument.
(define (make-suit suit ranks)
  (if (null? ranks)
      '()
      (cons (make-card (car ranks) suit)      ; adds one card to the list being made.
            (make-suit suit (cdr ranks)))))   ; generate the remaining cards (one less than before).

;; make-full-deck -> list
;; Generates a deck of 53 cards, by placing a joker on top of a standard deck.
(define (make-full-deck)
  (cons joker (make-standard-deck)))

;;; make-sequence number -> list
;;; Generates a list of numbers from 1 to n (the argument)
(define (make-sequence n)
  (letrec ((ms-aux (lambda (n lst)
                     (if (= n 0)
                         lst
                         (ms-aux (- n 1) (cons n lst))))))
    (ms-aux n '())))


;;;
;;; Functions that rearrange the elements in lists. The lists can be lists of any anything,
;;; e.g., numbers, but cards will work too.

;;; split : list -> (sublist sublist)
;;; Split divides the given list into two sublists, the first represents
;;; the top half of the deck, the second, the bottom half. If the list
;;; contains an even number of elements, then the two sublists will have
;;; the same length; otherwise the second will have one more element than
;;; the first. For example
;;;   (split '(1 2 3 4 5 6)) -> ((1 2 3) (4 5 6))
;;;   (split '(1 2 3 4 5 6 7)) -> ((1 2 3) (4 5 6 7))

(define (split deck)
  (split-aux (floor (/ (length deck) 2))  ;; first argument is half the number of cards in the deck
             '()                          ;; The top sublist is initially empty
             deck))                       ;; All cards are initially in the bottom sublist
 
;;; split-aux : number list list -> (list list)
;;; An auxilliary function used by split. The first argument represents the number of cards that
;;; need to be transferred from the top of the bottom sublist (third argument) to the tail
;;; of the top sublist (second argument). Note that top sublist is actually built in reverse
;;; order (cards are added to the head of the sublist using cons). Thus, we use reverse to put 
;;; the top sublist in the correct order at the very end. Split-aux is called once per card.
(define (split-aux offset top bottom)
  (if (= offset 0)
      (list (reverse top) bottom)  ; If no more cards need to be transferred, reorder top sublist.
      (split-aux (- offset 1) 
                 (cons (car bottom) top) (cdr bottom)))) ; transfer one card.

;;; riffle : list list -> list
;;; Interweaves the elements of two lists, as in a riffle (or faro) shuffle of a deck of cards.
;;; Note that the first element of the first list is placed at the front of
;;; the shuffled list. If the two lists have the same length, riffle corresponds to
;;; an out-shuffle. (Martin Gardner, "Mathematical Carnival," Knopf, NY, 1967, pp. 123-138.)
;;; For example
;;;   (riffle '(1 2 3) '(4 5 6)) -> (1 4 2 5 3 6)
(define (riffle a b)
  (cond [(null? a) b]
        [(null? b) a]
        [else (append (list (car a) (car b))
                      (riffle (cdr a) (cdr b)))]))

;;; in-shuffle : list -> list
;;; Performs what magicians call an in-shuffle for a deck of cards. The deck
;;; is cut into two equal halves, a riffle shuffle is performed such that the
;;; top card of the deck becomes the second card. For example,
;;;  (in-shuffle '(1 2 3 4 5 6))   -> (4 1 5 2 6 3)
;;;  (in-shuffle '(1 2 3 4 5 6 7)) -> (4 1 5 2 6 3 7).
(define (in-shuffle deck)
  (apply riffle (reverse (split deck))))

;;; out-shuffle : list -> list
;;; Performs what magicians call an out-shuffle for a deck of cards. The deck
;;; is cut into two equal halves, a riffle shuffle is performed such that the
;;; bottom card of the deck remains the bottom card. For example,
;;;  (out-shuffle '(1 2 3 4 5 6))   -> (1 4 2 5 3 6)
;;;  (out-shuffle '(1 2 3 4 5 6 7)) -> (4 1 5 2 6 3 7).
(define (out-shuffle deck)
  (if (even? (length deck))
      (apply riffle (split deck))
      (in-shuffle deck)))

;;; repeat : number function list -> list
;;; Applies a given list operation (op) a specified number of times (n)
;;; to a specified list (lst)
;;; For example, if one wants to perform 26 out-shuffles to a standard deck,
;;; evaluate (repeat 26 out-shuffle (make-standard-deck))
(define (repeat n op lst)
  (if (= n 0)
      lst
      (repeat (- n 1) op (op lst))))

;;; Applies a given operation (op) a specified number of times (n)
;;; to a specified list (lst). All intermediate results are displayed
;;; after an iteration index.
(define (verbose-repeat n op lst)
  (letrec ((vr (lambda (i l)
                  (display (list i l))
                  (newline)
                  (if (= i n)
                      l
                      (vr (+ i 1) (op l))))))
    (vr 0 lst)))


(define (random-riffle a b)
  (cond [(null? a) b]
        [(null? b) a]
        [(= (random 2) 0) 
         (append (list (car b) (car a))
                      (random-riffle (cdr a) (cdr b)))]
        [else (append (list (car a) (car b))
                      (random-riffle (cdr a) (cdr b)))]))

(define (random-shuffle deck)
  (apply random-riffle (split deck)))