;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; loop macros

;;(defmacro while (cond &body body)
;;  `(loop while ,cond do (progn ,@body)))

(defmacro crossloop (vars times &body body)
  (let ((form (cons 'progn `,body))
	(varsr (reverse vars)))
    (while varsr
      (let* ((now (car varsr))
	     (prev (cadr varsr))
	     (preve (if (null prev) 0 `(1+ ,prev))))
	(setf form `(do ((,now ,preve (1+ ,now))) ((>= ,now ,times) nil) ,form))
	(setf varsr (cdr varsr))))
    `,form))

(defun extract-sublist (vec &rest i)
  (let ((ret nil))
    (while i
      (push (aref vec (car i)) ret)
      (setf i (cdr i)))
    (nreverse ret)))

(defun crossmap (func size items)
  (let ((vars nil)
	(ritems (eval items)))
    (do ((i 0 (1+ i))) ((>= i size)) (setf vars (cons (gensym) vars)))
    (eval `(crossloop ,vars ,(length ritems) 
		      (apply ,func (extract-sublist ,ritems ,@vars))))))

(defun get-time-ms ()
  (/ (get-internal-real-time) (/ internal-time-units-per-second 1000)))

;; create a list of length n filled with symbol a
(defun nlist (a n)
  (cond ((<= n 0) nil)
        (t (cons a (nlist a (1- n))))))


(defun compete (game size maxtime &rest players)
  (apply #'compete-many (append (list 1 game size maxtime) players)))

(defun compete-many (num game size maxtime &rest players)
  (let ((counts (make-array (length players) :initial-element 0))
	(winners)
	(pv (make-array (length players) :initial-contents players)))
    (dotimes (ii num)
	    (crossmap #'(lambda (&rest ps)
			  (let ((winner (apply #'play-a-game 
					       (append 
						(list game maxtime)
						ps))))
			    (setf winners (cons winner winners))
			    (if (and winner (listp winner))
				(let ((inc (/ 1 (length winner)))
				      (w))
				  (dolist (w winner)
				    (incf (aref counts (position w players))
					  inc)))
			      (incf (aref counts (position winner players))))
  			    ))
		      size pv))
    (cons counts (nreverse winners))))
    
(defun compete-weighted (weights num game size maxtime &rest players)
  (let ((counts (make-array (length players) :initial-element 0))
	(scores (make-array (length players) :initial-element 0))
	(winners)
	(pv (make-array (length players) :initial-contents players)))
    (crossmap #'(lambda (&rest ps)
		  (let ((lcounts (make-array (length players) 
					     :initial-element 0)))
		    (dotimes (ii num)
		      (let ((winner (apply #'play-a-game 
					   (append 
					    (list game maxtime)
					    ps))))
			(setf winners (cons winner winners))
			(if (and winner (listp winner))
			    (let ((inc (/ 1 (length winner)))
				  (w))
			      (dolist (w winner)
				(incf (aref counts (position w players))
				      inc)
				(incf (aref lcounts (position w players))
				      inc)
				))
			  (progn
			    (incf (aref counts (position winner players)))
			    (incf (aref lcounts (position winner players)))))))
		    (incf-scores scores lcounts weights))
		  size pv))
    (cons counts (nreverse winners))))

;; weights are in the form of how many points one gets for each place
(defun incf-scores (scores wins weights)
  (while weights
    (let ((ptrs nil)
	  (max -1)
	  (aweight))
      (dotimes (i (length wins))
	(let ((maybe (aref wins i)))
	  (cond ((= maybe max) (push i ptrs))
		((> maybe max) (setf ptrs (list i)
				     max maybe)))))
      (setf aweight (/ (car weights) (length ptrs)))
      (dolist (ptr ptrs)
	(incf (aref scores ptr) aweight)
	(setf (aref wins ptr) -2))
      (setf weights (subseq weights (length ptrs)))))
  scores)


(defun play-a-game (game maxtime &rest players)
  (apply game (cons maxtime players)))


(defun compete-isolation (players)
  (compete-isolation-tourney 3 10000 iso-board-small players))

(defun compete-isolation-tourney (rounds time board players)
  (let ((iso3 (make-isogame-instance board)))
    (apply #'compete-many (append (list rounds iso3 3 time) players))))

(defun compete-rblockem-weighted (players)
  (compete-isolation-weighted-tourney '(5 3) 10 10000 be-small be-small-pieces
				     players))

(defun compete-isolation-weighted-tourney (weights rounds time board players)
  (let ((iso3 (make-isogame-instance board)))
    (apply #'compete-many-weighted (append (list weights rounds iso3 3 time) 
					   players))))


(defun compete-blockem (players)
  (compete-blockem-tourney 3 10000 be-small be-small-pieces players))

(defun compete-blockem-tourney (rounds time board pieces players)
  (let ((be3 (make-blockem-instance board pieces)))
    (apply #'compete-many (append (list rounds be3 4 time) players))))

(defun compete-blockem-weighted (players)
  (compete-blockem-weighted-tourney '(5 3 1) 10 10000 be-small be-small-pieces
				     players))
(defun compete-blockem-weighted-tourney (weights rounds time board pieces 
						 players)
  (let ((be3 (make-blockem-instance board pieces)))
    (apply #'compete-many-weighted (append (list weights rounds be3 4 time)
					   players))))


(defun compete-rblockem (players)
  (compete-rblockem-tourney 3 10000 be-small be-small-pieces players))

(defun compete-rblockem-tourney (rounds time board pieces players)
  (let ((be3 (make-rblockem-instance board pieces)))
    (apply #'compete-many (append (list rounds be3 4 time) players))))

(defun compete-rblockem-weighted (players)
  (compete-rblockem-weighted-tourney '(5 3 1) 10 10000 be-small be-small-pieces
				     players))

(defun compete-rblockem-weighted-tourney (weights rounds time board pieces
						  players)
  (let ((be3 (make-rblockem-instance board pieces)))
    (apply #'compete-many-weighted (append (list weights rounds be3 4 time)
					   players))))


;;;;;; Sample uses:

#|

(crossmap #'(lambda (i j) (format t "~a + ~a = ~a~%" i j (+ i j))) 2 (vector 1 2 3 4 5))

(crossmap #'(lambda (i j k) (format t "~a + ~a + ~a = ~a~%" i j k (+ i j k))) 3 (vector 1 2 3 4 5))

(defun twoplayerisolation (maxtime p1 p2)
  (setf ai_player1 p1)
  (setf ai_player2 p2)
  (let ((winner (play-game 5 5 3)))
    (if (equal winner 'x) p1 p2)))

(defun twoplayerisolation0 (maxtime p1 p2)
  (setf ai_player1 p1)
  (setf ai_player2 p2)
  (let ((winner (play-game 5 5 3)))
    winner))

(compete #'twoplayerisolation 2 0 (make-player #'eval-01) (make-player #'eval-01) (make-player #'eval-01))

(setf ip0 (make-player #'eval-01))
(setf ip1 (make-player #'eval-01-2p))
(setf ip2 (make-player #'eval-01-2pb))

(compete #'twoplayerisolation 2 0 ip0 ip1 ip2)

|#