;;; obo.el -- hack to run OBO simulations
;;; Author:  Sandra Loosemore


;;; Main entry point:
;;; Run the OBO simulation repeatedly over a list of competitors,
;;; recomputing the standings after each skater's marks are assigned.
;;; The input is a list of (skater-name ordinal1 ordinal2 ..) lists,
;;; in the order of skate.
;;; See obo-wjr.el or obo-euros.el for examples.

(defun obo-simulation (competitors-and-ordinals)
  (obo-simulation-recursive (reverse competitors-and-ordinals)))

(defun obo-simulation-recursive (competitors-and-ordinals)
  (if (null competitors-and-ordinals)
      nil
      (progn
	(obo-simulation-1
	   competitors-and-ordinals
	   (obo-simulation-recursive (cdr competitors-and-ordinals))
	   (car (car competitors-and-ordinals))))))



;;; Compute standings for a group of competitors using the OBO rules.

(defun obo-simulation-1 (competitors-and-ordinals prevresults newname)
  (let ((newresults
	 (assign-obo-placements
  	    (sort (compute-obo-results competitors-and-ordinals
				       competitors-and-ordinals)
		  'obo-results-<))))
    (print-obo-results newresults prevresults newname)
    newresults))


;;; Returns unsorted list of (competitor-name wins jifs)

(defun compute-obo-results (competitors-and-ordinals others)
  (if (null competitors-and-ordinals)
      nil
      (let ((tail  (compute-obo-results (cdr competitors-and-ordinals) others))
	    (me    (car competitors-and-ordinals))
	    (wins  0)
	    (jifs  0))
	(while others
	  (if (not (eq me (car others)))
	      (let ((temp  (obo-comparison me (car others))))
		;; temp = (win-p . jifs)
		(if (car temp) (setq wins (+ wins 1)))
		(setq jifs (+ jifs (cdr temp)))))
	  (setq others (cdr others)))
	(cons (list (car me) wins jifs) tail))))


;;; Returns (win-p . jifs) for me compared to other

(defun obo-comparison (me other)
  (let ((njudges  0)
	(wins     0))
    (setq me (cdr me))        ; skip competitor name
    (setq other (cdr other))  ; likewise
    (while (and me other)
      (setq njudges (+ njudges 1))
      (if (<= (car me) (car other))
	  (setq wins (+ wins 1)))
      (setq me (cdr me))
      (setq other (cdr other)))
    (cons (> wins (/ njudges 2)) wins)))



;;; Predicate for sorting OBO results list, each item is a list
;;; (competitor-name wins jifs)

(defun obo-results-< (result1 result2)
  (let ((wins1  (car (cdr result1)))
	(wins2  (car (cdr result2)))
	(jifs1  (car (cdr (cdr result1))))
	(jifs2  (car (cdr (cdr result2)))))
    (or (> wins1 wins2)
	(and (= wins1 wins2) (> jifs1 jifs2)))))


;;; Assign placements to sorted OBO results, looking for ties, etc.

(defun assign-obo-placements (results)
  (assign-obo-placements-recursive results 0 0 1 1))

(defun assign-obo-placements-recursive (results lastwins lastjifs place count)
  (if (null results)
      nil
      (let* ((me   (car results))
	     (name (car me))
	     (wins (car (cdr me)))
	     (jifs (car (cdr (cdr me)))))
	(if (not (and (= wins lastwins) (= jifs lastjifs)))
	    (setq place count))
	(setq count (+ count 1))
	(cons (cons place me)
	      (assign-obo-placements-recursive (cdr results) wins jifs
					       place  count)))))


;;; Print sorted OBO results with notes to indicate changes from previous
;;; results

(defun print-obo-results (results prevresults newname)
  (pop-to-buffer "OBO-Results")
  (end-of-buffer)
  (let ((sawit  nil))
    (while results
      (let* ((me    (car results))
	     (place (car me))
	     (name  (car (cdr me)))
	     (wins  (car (cdr (cdr me))))
	     (jifs  (car (cdr (cdr (cdr me))))))
	(insert (format "%2d.  %30s  %2d  %3d" place name wins jifs))
	(if (eq newname name)
	    (progn
	      (insert "  <=== new")
	      (setq sawit t))
	    (let* ((prev       (car prevresults))
		   (prevplace  (car prev))
		   (prevname   (car (cdr prev))))
	      (setq prevresults (cdr prevresults))
	      (if sawit
		  (setq prevplace (+ prevplace 1)))
	      (if (or (not (eq name prevname))
		      (not (= place prevplace)))
		  (insert "  <=== changed"))))
	(insert "\n")
	(setq results (cdr results)))))
  (insert "\n"))