Parimutuel Payout pProximation

bitbet.lisp

(use-package (mapcan 'ql:quickload '(:drakma :cl-json :local-time)))

(defun fetch-bet-json (id)
  (http-request (format () "http://bitbet.us/bet/~D/?json" id)))

(defun parse-json-str (str) (with-input-from-string (in str) (decode-json in)))

(defun process-bet-data (data)
  (loop for bet in (cdr (assoc :bets data))
     for side = (cdr (assoc :side bet))
     for weight = (parse-integer (cdr (assoc :weight bet)))
     for amount = (/ (parse-integer (cdr (assoc :amount--in bet))) (expt 10 8))
     if (string= side "Yes") sum (* weight amount) into yes-weight
     and sum amount into yes-amount
     else sum (* weight amount) into no-weight
     and sum amount into no-amount
     finally (return (list (cdr (assoc :weight--current data))
                           yes-weight no-weight yes-amount no-amount))))

(defun fetch-bet-status (id)
  (process-bet-data (parse-json-str (fetch-bet-json id))))

(defvar *bet-status-cache* (make-hash-table))

(defun bet-status (id &aux (now (now)))
  (rest (symbol-macrolet ((cache (gethash id *bet-status-cache*)))
          (or (if cache (< (timestamp-difference now (car cache)) 300) cache)
              (setf cache (cons (now) (fetch-bet-status id)))))))

(defun calc-payout (amount weight pot dilution)
  (* 99/100 (+ amount (/ (* amount weight pot) (+ dilution (* amount weight))))))

(defun calc-both (yes no id)
  (destructuring-bind (cw yw nw ya na) (bet-status id)
    (values (- (calc-payout yes cw (+ no na)  yw) yes no)
            (- (calc-payout no  cw (+ yes ya) nw) yes no))))

(defun anneal-bet (id funds &key (epsilon 0.0001) (descent -0.999) (bet :yes))
  (flet ((calc (r)
           (multiple-value-bind (yes no)
               (calc-both (* funds r) (* funds (- 1 r)) id)
             (case bet
               (:yes (and (plusp yes) (- (/ yes no))))
               (:no  (and (plusp no) (- (/ no yes))))))))
    (loop for delta = 1/2 then (* delta descent) with ratio = 1/2
       for lopsi = (or (calc ratio) -1)
       for candidate = (when (> 1 (+ ratio delta) 0) (calc (+ ratio delta)))
       ;; do (format t "~&R ~8F Δ ~8@F L ~8@F C ~8@F~%" ratio delta lopsi candidate)
       until (or (> epsilon (abs delta)))
       when (and candidate (> candidate lopsi))
       do (setf ratio (+ ratio delta))
       finally (return (let ((y-bet (* funds ratio))
                             (n-bet (* funds (- 1 ratio))))
                         (multiple-value-call #'values y-bet n-bet (calc ratio)
                                              (calc-both y-bet n-bet id)))))))