;;; -*-Lisp-*-

(defstruct casino
  max-spots
  payoff                                ; lookup (spot, catch) to get payoff
  balls
  sample
  bet
  expectation                           ; lookup (spot) to get anticipated return (should be negative) per unit bet
  )

;;; ----------------------------------------------------------------------

(defun get-matrix (ht spot catch)
  (when (> catch spot)
    (error "You can't catch more than the number of spots that you're betting."))
  (gethash (cons spot catch) ht 0))

(defsetf get-matrix (ht spot catch) (v)
  (let ((s (gensym))
        (c (gensym)))
    `(let ((,s ,spot)
           (,c ,catch))
       (when (> ,c ,s)
         (error "You can't catch more than the number of spots that you're betting."))
       (setf (gethash (cons ,s ,c) ,ht) ,v))))

(defun make-matrix (map &optional (norm 0.5)) ; most casinos make you bet $2 in Keno
  ;; f lets you modify the bet
  (let ((ht (make-hash-table :test 'equal)))
    (dolist (entry map)
      (destructuring-bind (spots &rest pairs) entry
        (dolist (pair pairs)
          (destructuring-bind (catch unnormalized-return) pair
            (setf (get-matrix ht spots catch) (* norm unnormalized-return))))))
    ht))

;;; ----------------------------------------------------------------------

(defvar *bellagio-keno-1999*
  ;; from their brochure I picked in late 1999
  ;; WARING---THIS MIGHT NO LONGER BE CURRENT
  (make-casino
   :max-spots 15
   :balls 80
   :sample 20
   :bet 2
   :expectation nil
   :payoff (make-matrix
            '((1 (1 6))
              (2 (2 24))
              (3 (2 2) (3 86))
              ;; when you bet on four spots,
              ;; catch 2 and get $2
              ;; catch 3 and get $8
              ;; catch 4 and get $230
              ;; (but you have to put down $2)
              (4 (2 2) (3 8) (4 230))
              (5 (3 4) (4 40) (5 1000))
              (6 (3 2) (4 8) (5 180) (6 3000))
              (7 (3 1) (4 3) (5 40) (6 720) (7 10000))
              (8 (5 18) (6 180) (7 3000) (8 50000))
              (9 (4 1) (5 6) (6 80) (7 600) (8 8000) (9 75000))
              (10 (5 4) (6 40) (7 280) (8 2000) (9 8000) (10 100000))
              (11 (5 2) (6 16) (7 160) (8 630) (9 3600) (10 25000) (11 130000))
              (12 (5 1) (6 6) (7 70) (8 520) (9 1000) (10 3000) (11 40000) (12 140000))
              (13 (0 2) (6 2) (7 36) (8 160) (9 1400) (10 6000) (11 20000) (12 100000) (13 150000))
              (14 (0 2) (6 2) (7 20) (8 80) (9 620) (10 2200) (11 6200) (12 50000) (13 100000) (14 200000))
              (15 (0 2) (6 2) (7 10) (8 60) (9 260) (10 620) (11 5000) (12 15000) (13 50000) (14 100000) (15 250000)))
            0.5)))
       
(defun correct (spots catch &key (balls 80) (sample 20))
  "The probability of catching exactly CATCH SPOTS."
  (assert (>= spots catch))
  (assert (<= spots sample))
  (labels ((C (n r)                     ; binomial coefficient
              (/ (reduce #'* (loop for i downfrom n above (- n r) collect i))
                 (reduce #'* (loop for i downfrom r above 1 collect i)))))
    (/ (* (C spots catch)
          (C (- balls spots)
             (- sample catch)))
       (C balls sample))))
                     
(defun TRIAL (&optional (casino *bellagio-keno-1999*))
  (setf (casino-expectation casino) nil)
  (format t "<table>")
  (format t "<tr><th>Spots</th><th>Catch</th><th>Win</th><th>Probability</th><th>Expected return</th></tr>~&")
  (loop for spots from 1 upto (casino-max-spots casino) do
        (let ((total-return -1))         ; we bet $1 to get in
          (loop for catch from 0 upto spots do
                (let ((m (get-matrix (casino-payoff casino) spots catch)))
                  (when (> m 0)
                    ;; when there is some money to be made....
                    (let ((p (correct spots catch :balls (casino-balls casino) :sample (casino-sample casino))))
                      ;; print the result
                      (format t "<tr><td>~D</td><td>~D</td><td>$~,2F</td><td>~F</td><td>$~,4F</td></tr>~&" spots catch m p (* p m))
                      ;; note that we can make money
                      (incf total-return (* p m))))))
          ;; now save the total return in the expectation table
          (push (cons spots total-return) (casino-expectation casino))))
  (format t "</table>")
  ;; sort 
  (setf (casino-expectation casino)
        (sort (casino-expectation casino) #'> :key #'cdr))
  ;; print out the expectations
  (format t "<table>~&")
  (format t "<tr><th>For every $1 bet on this many spots,</th><th>on average, you will lose....</th></tr>~&")
  (dolist (e (casino-expectation casino))
    (format t "<tr><td>~D</td><td>$~,2F</td></tr>~&" (car e) (- (cdr e))))
  (format t "</table>~&"))


;;; ======================================================================

;;; I did this just because I wanted to double-check my combinatorial result

(defun keno (spots                      ; how many spots we pick (balls)
             want                       ; how many balls we *want* to catch
             &key
             ;; the number of balls left to choose from, usually 80
             (balls 80)
             ;; the number of balls left to pick, usually 20
             (sample 20)
             ;; how many spots were caught so far....
             (caught 0)
             ;; the probability of being at this point in phase space
             (probability 1))
  "Returns the probability of catching WANT of SPOTS."
  (cond ((> caught want) 0) ; too many spots were caught
        ((< (+ caught spots) want) 0) ; even if we won them all, we wouldn't have enough
        ((zerop sample)
         (if (= want caught) probability 0))
        ((zerop spots) ; no more hits are left
         ;; the extra draws do not impact us, we hit everything
         (if (= want caught) probability 0))
        (t
         ;; we draw a ball
         (let ((p-want (/ spots balls)))
           (+
            ;; the "hit" case
            (keno (- spots 1)
                  want                 ; conserved
                  :balls (- balls 1)
                  :sample (- sample 1)
                  :caught (+ caught 1)
                  :probability (* probability p-want))
            ;; the "miss" case
            (keno  spots
                   want                ; conserved
                   :balls (- balls 1)
                   :sample (- sample 1)
                   :caught caught
                   :probability (* probability (- 1 p-want))))))))


;;; This is a much faster memoized version of the above....

(defvar *ht* (make-hash-table :test 'equal))

(defun keno2 (spots                     ; how many spots we pick (balls)
              want                      ; how many balls we *want* to catch
              &key
              ;; the number of balls left to choose from, usually 80
              (balls 80)
              ;; the number of balls left to pick, usually 20
              (sample 20)
              ;; how many spots were caught so far....
              (caught 0))
  "Returns the probability of catching WANT of SPOTS."
  (let ((state (list spots want balls sample caught)))
    (cond ((gethash state *ht*))
          ((> caught want) 0)           ; too many spots were caught
          ((< (+ caught spots) want) 0) ; even if we won them all, we wouldn't have enough
          ((zerop sample)
           (if (= want caught) 1 0))
          ((zerop spots)                ; no more hits are left
           ;; the extra draws do not impact us, we hit everything
           (if (= want caught) 1 0))
          (t
           ;; we draw a ball
           (let ((p-want (/ spots balls)))
             (let ((result 

                    (+
                     ;; the "hit" case
                     (* p-want
                        (keno2 (- spots 1)
                               want     ; conserved
                               :balls (- balls 1)
                               :sample (- sample 1)
                               :caught (+ caught 1)))
                     ;; the "miss" case
                     (* (- 1 p-want)
                        (keno2  spots
                                want    ; conserved
                                :balls (- balls 1)
                                :sample (- sample 1)
                                :caught caught)))))
               (setf (gethash state *ht*) result)
               (if (zerop (random 5000)) (print (hash-table-size *ht*)))
               result))))))



(defun check ()
  "Exhaustively make sure that the above two results are the same (takes a while)."
  (loop for spots from 1 upto 20 do
        (loop for catch from 0 upto spots do
              (if (= (correct spots catch)
                     (keno2 spots catch))
                  (princ ".")
                (error "We messed up on ~A ~A." spots catch)))))