;IPD Monitor Code
;CMPS 140 Winter 2007
;Foaad Khosmood
;some contribution from Winter 2006 monitor by Andrew Trapani


;Sample Agents
(defun JohnyCC (hist score)
	hist
	score
	'(D C C))
	
(defun CCC (hist score)
	hist
	score
	'(C C C))

(defun DarkwingDuck (hist score)
	hist
	score
	'(D D D))
	
(defun ThreeD (hist score)
	hist
	score
	'(D D D))
	
(defun AynRand (hist score)
	hist
	score
	(mapcar #'(lambda (x)
			   	(if (> (random x) (/ x 2)) 'C 'D))
			   	'(1000 1000 1000)))

(defun DCD (hist score)
	hist
	score
	'(D C D))
			   	

;Globals
(defvar finalscores)
(defvar agentlist)
(defvar totals)
(defvar verbose)

(setf agentlist '(johnycc ccc dcd threed darkwingduck aynrand))
(setf totals (mapcar #'(lambda (x) x 0) agentlist))
(setf finalscores nil)
(setf verbose 2)

;Payoff Matrix
(defun evalMove (move1 move2)
	(if (eql move1 'C)
		(if (eql move2 'C)
			'(3 3)
			'(0 5))
		(if (eql move2 'C)
			'(5 0)
			'(1 1))))

(defun addTuples (s1 s2)
	(list (+ (first s1)
			 (first s2))
		  (+ (second s1)
		  	 (second s2))))
			   	
;Turn evaluator
(defun evalTurn (moveSet1 moveSet2)
	(if (null moveSet1) 
		'(0 0)
		(list (+ (first (evalMove (first moveSet1) 
								  (first moveSet2)))
				 (first (evalTurn (rest moveSet1) 
				 				  (rest moveSet2))))
			  (+ (second (evalMove (first moveSet1)
			  					   (first moveSet2)))
			  	 (second (evalTurn (rest moveSet1)
			  	 				   (rest moveSet2)))))))
;Flip one move by chance F
;changed to accomodate people who return a list of one as opposed to 
; 'C or 'D	  
(defun flipMove (move F)
;	(flipMove (car move))
	(if (>  (* 100 F) (random 100))
		(if (eql move 'C)
			'D
			'C)
		move))
		
;Flip one palyer's whole Set of moves by chance F		  
(defun flipSet (moveSet F)
	(if (null moveSet)
		moveSet
		(cons (flipMove (first moveSet) F)
			  (flipSet (rest moveSet) F))))
			  
;Flip both players' turn by chance F
(defun flipTurn (moveSet1 moveSet2 F)
	(list (flipSet moveSet1 F)(flipSet moveSet2 F)))
	
;pairScores serializes scores
;accepts two triples (a b c) (x y z), returns ((a x)(b y)(c z))
(defun pairScores (list1 list2)
	(if (null list1) nil
		(cons (list (first list1)
		            (first list2))
		      (pairScores (rest list1) (rest list2))))) 
			  	

;reverseHistory
;accepts a list of tuples, returns a list with every tuple reversed (a b) -> (b a)
(defun reverseTuples (lis)
	(if (null lis) nil
		(cons (reverse (first lis))
			  (reverseTuples (rest lis)))))
		  	 
(defun addHist (lis1 lis2)
	(if (null lis1) lis2
		(cons (first lis1) (addHist (rest lis1) lis2))))
		

		
(defun legalMove (m)
	(if (or (eq m 'C)
			(eq m 'D))
		t
		nil))
	
(defun getR (agent hist score)
	(let ((R (funcall agent hist score)))
		 (if (and (listp R) 
		 		  (not (null R)))
		 		(if (and 	(legalMove (first R))
		 					(legalMove (second R))
		 					(legalMove (third R)))
		 			R
		 			(format t "~% >>>>>>>> illegal move - ~A - by agent ~A" R agent))
		 		(format t "~% >>>>>>>> badly formed response - ~A - by agent ~A" R agent))))
		

;plays a single one-on-one game given any score for number of turns
(defun ipdGame (agent1 agent2 hist score F I turns)
	(when (> verbose 3) (format t "~% history= ~A" hist))
	(if (< turns 1) 
		score
		(let*   ((a1response (flipSet (getR agent1 hist score) F))
                 (a2response (flipSet (getR agent2 (reverseTuples hist) (reverse score)) F))
				 (newScore (addTuples score (evalTurn a1response a2response)))
				 (newHist (addHist hist (pairScores a1response a2response)))
				 (newF (max 0 (- F I))))
				 (ipdGame agent1 agent2 newHist newScore newF I (- turns 1)))))
							  		      
;Plays one game of variable turns, returns scores (just for that game)
(defun playGame (agent1 agent2 turns F I)
	(let ((result
			(ipdGame agent1 agent2 nil '(0 0) F I turns)))
		 (if (> verbose 2)
		 	 (progn 
		 	 	(format t "~% Now Playing: ~A ~A" (cons agent1 agent2) result)
	 	 	;	(format t "~% Result: ~A" result)
				)
		 	 (if (eq verbose 2)
			 	(format t "x"))
		 )
		 result))

	
;returns number of agents.
(defun agentnum (name agentslist)
       (position name agentslist))
	
;Update the total scores.
(defun updatetotals (agnum1 agnum2 gameScores totals)
 (setf (nth agnum1 totals) (+ (first gameScores) (nth agnum1 totals)))
 (setf (nth agnum2 totals) (+ (second gameScores) (nth agnum2 totals)))
 totals)

;Plays one round-robin (everyone plays everyone else including self)
(defun roundRobin (agents F I turns)
	(mapcar	#'(lambda (agent1)
      			(mapcar #'(lambda (agent2)
	   					(if (and (not (null agent1))
	   						 (not (null agent2)))
	       					(setf totals 
							  (updatetotals 
		 					  (agentnum agent1 agents) 
		 					  (agentnum agent2 agents) 
		 					  (playGame agent1 agent2 turns F I) 
		 					   totals))))
		 					   
       				(member agent1 agents)))
  		agents)
 	totals)
 	
;Remove the worst performing agents.
(defun prune (agents totals minval)
 (if (null totals) nil
   (if (eql (car totals) minval)
       (prune (rest agents) (rest totals) minval)
       (apply #'list (car agents) 
	   		(prune (rest agents) (rest totals) minval)))))

(defun addFinalScores (losers finalList)
   (if (eql 1 (length losers)) 
       (cons (first losers) finalList)
       (cons (first losers) (addFinalScores (rest losers) finalList))))
 
(defun runMonitor (flipParams gameLengthParams agents)
	(let* ((F (first flipParams))
		   (I (second flipParams))
		   (Lmin (first gameLengthParams))
		   (Lmax (second gameLengthParams))
		   (Ldif (- Lmax Lmin)))
		   (if (< Ldif 1)
		   	   (roundRobin agents F I (max Lmin 1))
		   	   (roundRobin agents F I (+ (random Ldif) 
		   	   							 Lmin)))))
		   	
(defun printTotals (agents)
	(if (null agents) 
	nil
	(format t "~% standings: ~A" (sort (mapcar #'(lambda (x) 
						  (cons x 
							(nth (position x agents) 
							     totals)))
								       agents)
					#'(lambda (x y) 
						(> (cdr x)(cdr y)))
						))))
											 
(defun ipdMonitor (flipParams gameLengthParams agents)
	(if (> verbose 1)
		(progn 
			(printTotals agents)
			(terpri))
		nil)
	(if (null agents) 
		finalscores
		(let ((minval (apply 'min (runMonitor flipParams gameLengthParams agents))))
	    	 (let ((newAgents (prune agents totals minval)))
	    	 	  (setf totals (remove minval totals))
	    	 	  (setf finalscores (cons (list (first (set-difference agents newAgents)) 
	    	 	                                minval) 
	    	 	                          finalscores))
;	    	 	  (setf finalscores (mapcar #'(lambda (x) (cons x finalscores)) 
;	    	 	  	  (mapcar #'(lambda (x) (list x minval)) 
;	    	 	  	  	(set-difference agents newAgents))))
	    	 	  (ipdMonitor flipParams gameLengthParams newAgents)))))
	    	 	  
(defun monitor (flipParams gameLengthParams agents)
	(setf totals (mapcar #'(lambda (x) x 0) agents))
	(setf finalscores nil)
	(ipdMonitor flipParams gameLengthParams agents))	 	  
	    	 	  
;sample usage:
;(monitor '(0.25 0.05) '(30 40) agentlist)


;P2 Championships
(defvar rankings)
(defun getRanks (result)
	(if (null result) 
		nil
		(append (list (first (car result)) (length result)) (getRanks (cdr result)))))

(defun championship (flipParamList gameLengthList agents)
;	(setf rankings (mapcar #'(lambda (x) x 0) agents))
	(setf rankings nil)
	
	(mapcar #'(lambda (flipParam) 
			   (mapcar #'(lambda (gameLengthParam)
			   			  (let ((result (monitor flipParam gameLengthParam agents)))
			   			  	(if (> verbose 0)
			   			  	  (progn 
							  	(format t "~% Current Params: Flip=~A GameLength=~A Results=~A" flipParam gameLengthParam result)
						    	(format t "~% Rankings=~A" (getRanks result)) ))))
						  gameLengthList))
			  flipParamList)
	t)