(in-package :user)

(defun init ()
  (setq *print-level* 5)
  (load "~/lisp/nyttig/splitt"))

(defvar *origin* nil "Whether this is an European or American tournament")
(defvar *reordering* nil "Whether the original ordering should be preserved.")

(defun run (&key (berger nil))
  (setq *handicap* nil
	*origin* nil
	*reordering* :undefined
	*special-promotions* nil
	*delayed-promotions* nil)
  (les "turnering.txt")
  (calculate)
  (read-table)
  (find-players)
  (unless *origin* (setq *origin* (find-origin)))
  (reorder berger)
  (show-players)
  (+/-)
  (special-promotions)
  (empty-simultan)
  (when (eql *origin* #\A) (change-us-names))
  (skriv1)
  (skriv2)
  (skriv3)
  (skriv4-html "turnering.html")
  (find-promotions)
  (delayed-promotions)
  ;;(update-handicap-scores)
  (write-table)
  (show-players)
  (show-all *date*))

(defun redo (year &key (from 1)(to 72)(berger nil))
  (tpl:do-command "cd" (format nil "~d/t~d/" year from))

  (when (= from 1)
    (excl:run-shell-command "cp ../ratingliste.start ./ratingliste.pre"))
  (do ((next (1+ from) (1+ next)))
      ((> next to))
    (run :berger berger)
    (excl:run-shell-command 
     (format nil "cp ./ratingliste.post ../t~d/ratingliste.pre" next))
    (tpl:do-command "cd" (format nil "../t~d/" next)))
  (tpl:do-command "cd" "../../"))


(defun redo-2000 (&key (from 1)(to 78)(berger nil))
  (redo 2000 :from from :to to :berger berger))

(defun redo-2001 (&key (from 1)(to 60)(berger nil))
  (redo 2001 :from from :to to :berger berger))

(defun redo-2002 (&key (from 1)(to 63)(berger nil))
  (redo 2002 :from from :to to :berger berger))

(defun redo-2003 (&key (from 1) (to 61) (berger nil))
  (redo 2003 :from from :to to :berger berger))

(defun redo-2004 (&key (from 1) (to 64) (berger nil))
  (redo 2004 :from from :to to :berger berger))

(defun redo-2005 (&key (from 1) (to 61) (berger nil))
  (setq *super-bonus-active* nil)
  (redo 2005 :from from :to to :berger berger))

(defun redo-2006 (&key (from 1) (to 12) (berger nil))
  (setq *super-bonus-active* nil)
  (redo 2005 :from from :to to :berger berger))

(defun rdo (n &key (berger nil)(year 2006))
  (redo year :from n :to (1+ n) :berger berger))

(defvar +e-limit+ 18)
(defvar +u-limit+ 9)
(defvar +max-games/table+ 16)


(defparameter *rating* nil)
(defparameter *results* nil)
(defparameter *all* nil)
(defparameter *name* nil)
(defparameter *date* nil)
(defparameter *handicap* nil)
(defparameter *super-bonus-active* t)

(defmacro while (test &rest body)
  `(do ()
       ((not ,test))
     ,@body))

(defun beste (liste &key (test #'>)(key #'identity))
   (when (null liste)(return-from beste nil))
   (let* ((beste (car liste))
	  (beste-verdi (funcall key beste))
	  ny-best)
      (dolist (ny (cdr liste))
	 (when (funcall test (setq ny-best (funcall key ny)) beste-verdi)
	    (setq beste ny
		  beste-verdi ny-best)))
      beste))
	    
(defun les (filename)
  (with-open-file (f filename :direction :input)
    (let ((nr 0)
	  (started nil)
	  (ended nil)
	  (results nil)
	  nr-2)
      (setq *name* (get-item f))
      (setq *date* (get-item f))
      (do ((line (read-line f nil :eof)(read-line f nil :eof)))
	  ((eq line :eof))
	(setq nr-2 (parse-integer line :junk-allowed t))
	(cond ((or (= 0 (length line))
		   (char= #\; (char line 0))))
	      ((not (or (position #\+ line)
			(position #\- line)
			(position #\= line)
			(position #\& line)))
	       (format t ".")
	       (when started 
		 (unless ended (setq ended t))))
	      (ended (error "+/-/= starts stops and starts again: ~a" line))
	      ((and (not started)(not (equal nr-2 1))) (format t ","))
	      (t (format t ":")
		 (unless started
		   (unless (equal 1 nr-2)
		     (error "First player not nr 1: ~a" line))
		   (setq started t))
		 (push (cons (incf nr)
			     (parse-line line))
		       results))))
      (unless started (error "No results read"))
      (setq *results* (reverse results)))))

(defun parse-line (line)
  (let ((macmahon 0)
	last-name first-name supplements results pos-[ pos-])
    (setq pos-[ (position #\[ line)
	  pos-] (position #\] line))
    (when (< pos-] pos-[) (error "Unable to parse(1) [ and ] in ~a" line))
    (setq last-name (subseq line (1+ pos-[) pos-]))
    
    (setq pos-[ (position #\[ line :start (1+ pos-[)))
    (when (< pos-[ pos-]) (error "Unable to parse(2) [ and ] in ~a" line))
    (setq pos-] (position #\] line :start (1+ pos-])))
    (when (< pos-] pos-[) (error "Unable to parse(3) [ and ] in ~a" line))
    (setq first-name (subseq line (1+ pos-[) pos-]))
    
    (setq pos-[ (position #\[ line :start (1+ pos-[)))
    (when (< pos-[ pos-]) (error "Unable to parse(4) [ and ] in ~a" line))    
    (setq supplements (subseq line (1+ pos-]) pos-[))
    (setq pos-] (position #\] line :start (1+ pos-])))
    (when (< pos-] pos-[) (error "Unable to parse(5) [ and ] in ~a" line))
    (setq results (subseq line (1+ pos-[) pos-]))
    
    (setq pos-[ (position #\[ line :start (1+ pos-[)))
    (when pos-[
      (when (< pos-[ pos-]) (error "Unable to parse(6) [ and ] in ~a" line))
      (setq pos-] (position #\] line :start (1+ pos-])))
      (when (< pos-] pos-[) (error "Unable to parse(5) [ and ] in ~a" line))
      (setq macmahon (read-from-string (subseq line (1+ pos-[) pos-]))))
      
    (list* last-name first-name supplements macmahon (splitt-results results))))

(defun get-item (f)
  (let (start stop)
    (do ((line (read-line f nil :eof)(read-line f nil :eof)))
	((eq :line :eof))
      (when (and (setq start (position #\[ line))
		 (setq stop (position #\] line)))
	(return (subseq line (1+ start) stop))))))

(defvar *white-space* (list #\space #\return #\newline #\tab))

(defun next-none-whitespace (line &key (start 0))
  (let ((end (length line)))
    (while (and (< start end)
		(member (char line start) *white-space*))
	   (incf start))
    (when (< start end)(values (char line start) 
			       (1+ start)))))

(defun splitt-results (line)
  (let ((results nil)
	(parts nil)
	(pos 0)
	pos2
	(end (length line))
	next result tall side)
    (when (string= "&" (string-trim " " line))
      (return-from splitt-results :simultan))
    (while (< pos end)
	   (setq parts nil)
	   (setq next (next-none-whitespace line :start pos))
	   (unless next (return))
	   (unless (digit-char-p next)(error "Forventet tall : ~a " (subseq line pos)))
	   (multiple-value-setq (tall pos)(parse-integer line 
							 :start pos 
							 :junk-allowed t))
	   (push tall parts)
	   (multiple-value-setq (result pos)
	     (next-none-whitespace line :start pos))
	   (push result parts)
	   (multiple-value-setq (next pos2)
	     (next-none-whitespace line :start pos))
	   (when (and next
		      (char= next #\())
	     (multiple-value-setq (side pos)
	       (next-none-whitespace line :start pos2))
	     (push side parts)
	     (setq pos2 (position #\) line :start pos))
	     (push (string-trim *white-space* (subseq line pos pos2))
		   parts)
	     (setq pos (1+ pos2)))
	   (push (reverse parts) results))
    (reverse results)))

(defstruct player 
  (last-name "")
  (first-name "")
  nationality-list
  (grade-level 0)
  (grade-name "")
  (nsr-grade-level 0)
  (nsr-grade-name "")
  elo-number
  games
  last-played
  (lb-count nil)
  (mp-count nil))

(defstruct spiller 
  last-name 
  first-name
  supplements
  (result-rounds nil)
  (opponent-rounds nil)
  (handicap-side nil)
  (handicap-type nil)
  (clean-motstander-results nil)
  (u/p-k 1)
  (u-player nil)
  (simultan-p nil)
  (post-ant 0)
  (pts 0)
  sos
  sb
  (cum 0)
  (significance nil)
  nr
  old-spiller
  (rating-change 0))

(defstruct home
  list					; #\E or #\A
  nationality
  residens
  last)

(defun spiller-navn (spiller)
  (format nil "~a ~a" (spiller-last-name spiller)(spiller-first-name spiller)))


(defvar *dummy* nil)

(defun make-dummy (elo &optional (u/p-k 1))
   (make-spiller :old-spiller (make-player :elo-number elo)
		 :u/p-k u/p-k))

(defun pre-ant (spiller)
  (let ((value (player-games (spiller-old-spiller spiller))))
    (cond ((listp value) (length value))
	  (t value))))
    
(defun post-ant (spiller)
   (spiller-post-ant spiller))

(defun (setf post-ant)(ant spiller)
   (setf (spiller-post-ant spiller) ant))

(defun calculate ()
  (let ((all (mapcar 
	      (lambda (line)
		(make-spiller :last-name (second line)
			      :first-name (third line)
			      :supplements (string-trim '(#\space #\tab) 
							(fourth line))
			      :nr (first line)
			      :pts (fifth line)
			      :cum (* (fifth line)
				      (if (listp (nthcdr 5 line))
					  (length (nthcdr 5 line))
					0))
			      :simultan-p (eq :simultan (nthcdr 5 line))))
	      *results*))
	motspiller)
    (push (setq *dummy* (make-spiller :last-name "DUMMY" 
				      :nr 0 :pts 0) )
	  all)
    (mapcar (lambda (spiller line)
	      (unless (eq :simultan (nthcdr 5 line))
		(dolist (x (reverse (nthcdr 5 line)))
		  (push (nth (first x) all)(spiller-opponent-rounds spiller))
		  (push (ecase (second x)
			  (#\+ 1)
			  (#\- 0)
			  (#\= 1/2))
			(spiller-result-rounds spiller))
		  (when (third x)(setq *handicap* t))
		  (push (third x)(spiller-handicap-side spiller))
		  (push (fourth x)(spiller-handicap-type spiller)))))
	    (cdr all) *results*)
    (dolist (spiller (cdr all))
      (unless (spiller-simultan-p spiller)
	(dotimes (round (length (spiller-opponent-rounds spiller)))
	  (setq motspiller (nth round (spiller-opponent-rounds spiller)))
	  (unless motspiller (error "Who did ~a ~a play against in round ~a?"
				    (spiller-last-name spiller)
				    (spiller-first-name spiller)
				    (1+ round)))
	  (cond ((eq motspiller *dummy*))
		((spiller-simultan-p motspiller)
		 (push spiller (spiller-opponent-rounds motspiller))
		 (push (- 1 (nth round (spiller-result-rounds spiller)))
		       (spiller-result-rounds motspiller))
		 (push (ecase (nth round (spiller-handicap-side spiller))
			 (#\+ #\-)
			 (#\- #\+)
			 ((nil) nil))
		       (spiller-handicap-side motspiller))
		 (push (nth round (spiller-handicap-type spiller))
		       (spiller-handicap-type motspiller)))
		((not (eq spiller (nth round (spiller-opponent-rounds motspiller))))
		 (error "Spillte ~a og ~a mot hverandre i runde ~a?" 
			(spiller-navn spiller)
			(spiller-navn motspiller)
			(1+ round)))
		((not (= 1 (+ (nth round (spiller-result-rounds spiller))
			      (nth round (spiller-result-rounds motspiller)))))
		 (error "~a og ~a fikke ikke et poeng tilsammen i runde ~d (~a ~a  ~a ~a)" 
			(spiller-navn spiller)
			(spiller-navn motspiller)
			(1+ round)
			(spiller-result-rounds spiller)
			(mapcar #'spiller-navn (spiller-opponent-rounds spiller))
			(spiller-result-rounds motspiller)
			(mapcar #'spiller-navn 
				(spiller-opponent-rounds motspiller))))
		(t (sjekk-handicap round spiller motspiller))))))
    (dolist (spiller (cdr all))
      (incf (spiller-pts spiller)
	(reduce #'+ (spiller-result-rounds spiller))))
    (dolist (spiller (cdr all))
      (setf (spiller-sos spiller)
	(reduce #'+ (mapcar (lambda (spiller)(spiller-pts spiller))
			    (spiller-opponent-rounds spiller))))
      (setf (spiller-sb spiller)
	(reduce #'+ (mapcar (lambda (spiller result)
			      (* result (spiller-pts spiller)))
			    (spiller-opponent-rounds spiller)
			    (spiller-result-rounds spiller))))
      (incf (spiller-cum spiller)
	(let ((sum 0)
	      (sum-sum 0))
	  (dolist (res (spiller-result-rounds spiller))
	    (incf sum res)
	    (incf sum-sum sum))
	  sum-sum)))
    (dolist (spiller (cdr all))
      (setf (spiller-clean-motstander-results spiller)
	(remove-if (lambda (x)(eq (first x) *dummy*))
		   (mapcar #'list
			   (spiller-opponent-rounds spiller)
			   (spiller-result-rounds spiller)
			   (spiller-handicap-side spiller)
			   (spiller-handicap-type spiller))))
      (when (> (length (spiller-clean-motstander-results spiller)) +max-games/table+)
	(error "To many games in one table: ~a (~d)" 
	       (spiller-navn spiller) (length (spiller-clean-motstander-results spiller)))))
    (setq *all* (cdr all))))

(defun sjekk-handicap (round spiller motspiller)
  (let ((side1 (nth round (spiller-handicap-side spiller)))
	(side2 (nth round (spiller-handicap-side motspiller)))
	(type-1 (nth round (spiller-handicap-type spiller)))
	(type-2 (nth round (spiller-handicap-type motspiller))))
    (unless (or (and (null side1)
		     (null side2))
		(and (char= #\+ side1)
		     (char= #\- side2))
		(and (char= #\- side1)
		     (char= #\+ side2)))
      (error "With handicap one player has to give and the other receive: Round ~d: ~a -  ~a" 
	     (1+ round)
	     (spiller-navn spiller)
	     (spiller-navn motspiller)))
    (unless (or (and (null side1)
		     (null type-1)
		     (null type-2))
		(and side1 side2
		     (string-equal type-1 type-2)))
      (error "With handicap, both players must be influenced by the same handicap: Round ~d: ~a -  ~a" 
	     (1+ round)
	     (spiller-navn spiller)
	     (spiller-navn motspiller)))))

(defun find-origin ()
  (let ((eu 0)
	(us 0))
    (dolist (spiller *all*)
      (let ((nat-list (player-nationality-list 
		       (spiller-old-spiller spiller))))
	(when (member #\E nat-list :key #'home-list)
	  (incf eu))
	(when (member #\A nat-list :key #'home-list)
	  (incf us))))
    (cond ((> us eu) #\A)
	  ((>= eu us) #\E)
	  (t (error "EU or US tournament?")))))

(defun change-us-names ()
  (dolist (spiller *all*)
    (let ((old (spiller-first-name spiller)))
      (when (and (> (length old) 3)
		 (string-not-equal old "Mrs."))
	(setf (spiller-first-name spiller)
	  (format nil "~c." (char old 0)))))))
						   
(defun skriv1 ()
  (let ((last-name-size (reduce #'max (mapcar (lambda (spiller)
						(length (spiller-last-name spiller)))
					      *all*)))
	(first-name-size (reduce #'max (mapcar (lambda (spiller)
						(length (spiller-first-name spiller)))
					      *all*)))
	(supplement-size (reduce #'max (mapcar (lambda (spiller)
						 (length (spiller-supplements spiller)))
					       *all*))))
    (dolist (spiller *all*)
      (format t "~%~:[ =~;~:*~2d~] ~va ~va ~v@a ~4d~:[ ~;*~] ~{~{~2d~c~:[~2*~;~:[~*     ~;(~:*~c~2a)~]~]~} ~} ~2d ~:[   ~;~:*~3d~] ~:[   ~;~:*~3d~] ~:[   ~;~:*~3d~] ~:[~;~:*~4@d~]"
	      (if (= (spiller-significance spiller) 5) nil (spiller-nr spiller))
	      last-name-size
	      (spiller-last-name spiller)
	      first-name-size	      
	      (spiller-first-name spiller)
	      supplement-size
	      (spiller-supplements spiller)
	      (if (spiller-u-player spiller)
		  (spiller-rating-change spiller)
		  (player-elo-number (spiller-old-spiller spiller)))
	      (spiller-u-player spiller)
	      (mapcar (lambda (motstander result h-side h-type)
			(list (spiller-nr motstander) 
			      (ecase result 
				(1 #\+)
				(0 #\-)
				(1/2 #\=))
			      *handicap*
			      h-side
			      h-type))
		      (spiller-opponent-rounds spiller)
		      (spiller-result-rounds spiller)
		      (spiller-handicap-side spiller)
		      (spiller-handicap-type spiller))
	      (spiller-pts spiller)
	      (if (>= (spiller-significance spiller) 2)(spiller-sos spiller) nil)
	      (if (>= (spiller-significance spiller) 3)(spiller-sb spiller) nil)
	      (if (>= (spiller-significance spiller) 4)(spiller-cum spiller) nil)
	      (if (spiller-u-player spiller)
		  nil
		  (spiller-rating-change spiller))))))

(defun skriv2 ()
  (let ((last-name-size (reduce #'max (mapcar (lambda (spiller)
						(length (spiller-last-name spiller)))
					      *all*)))
	(first-name-size (reduce #'max (mapcar (lambda (spiller)
						 (length (spiller-first-name spiller)))
					       *all*))))
    (format t "~2%~a~%Nr Name ~vtNat  Grade         ELO  " *name* (+ last-name-size first-name-size 5))
    (dotimes (r (length (spiller-opponent-rounds (second *all*))))
      (format t " ~2d " (1+ r))
      (when *handicap* (format t "     ")))
    (format t " Pts Sos  Sb Cum  +/-")
    (dolist (spiller *all*)
      (format t "~%~:[ =~;~:*~2d~] ~va ~va ~3a ~:[~*  ~;~2d~] ~3a ~:[~2*       ~;(~d ~3a)~] ~4d~:[ ~;*~] ~{~{~2d~c~:[~2*~;~:[~*     ~;(~:*~c~2a)~]~]~} ~} ~2d ~:[   ~;~:*~3d~] ~:[   ~;~:*~3d~] ~:[   ~;~:*~3d~] ~:[~;~:*~4@d~]"
	      (if (= (spiller-significance spiller) 5) nil (spiller-nr spiller))
	      last-name-size
	      (spiller-last-name spiller)
	      first-name-size	      
	      (spiller-first-name spiller)
	      (home-nationality (first (player-nationality-list
					(spiller-old-spiller spiller))))
	      (plusp (player-grade-level (spiller-old-spiller spiller)))
	      (player-grade-level (spiller-old-spiller spiller))
	      (player-grade-name (spiller-old-spiller spiller))
	      (plusp (player-nsr-grade-level (spiller-old-spiller spiller)))
	      (player-nsr-grade-level (spiller-old-spiller spiller))
	      (player-nsr-grade-name (spiller-old-spiller spiller))
	      (if (spiller-u-player spiller)
		  (spiller-rating-change spiller)
		  (player-elo-number (spiller-old-spiller spiller)))
	      (spiller-u-player spiller)
	      (mapcar (lambda (motstander result h-side h-type)
			(list (spiller-nr motstander) 
			      (ecase result 
				(1 #\+)
				(0 #\-)
				(1/2 #\=))
			      *handicap*
			      h-side
			      h-type))
		      (spiller-opponent-rounds spiller)
		      (spiller-result-rounds spiller)
		      (spiller-handicap-side spiller)
		      (spiller-handicap-type spiller))
	      (spiller-pts spiller)
	      (if (>= (spiller-significance spiller) 2)(spiller-sos spiller) nil)
	      (if (>= (spiller-significance spiller) 3)(spiller-sb spiller) nil)
	      (if (>= (spiller-significance spiller) 4)(spiller-cum spiller) nil)
	      (if (spiller-u-player spiller)
		  nil
		  (spiller-rating-change spiller))))))

(defun skriv2-html (filename)
  (with-open-file (f filename :direction :output :if-exists :supersede)
    (format f "~%<table>~%<tr><td>Nr</td><td>Name</td><td></td><td>Nat </td><td>Grade </td><td>ELO</td><td>")
    (dotimes (r (length (spiller-opponent-rounds (second *all*))))
      (format f " ~2d</td><td>" (1+ r)))
    (format f "Pts</td><td>Sos</td><td>Sb</td><td>Cum</td><td>+/-</td></tr>")
    (dolist (spiller *all*)
      (format f "~%<tr><td>~:[ =~;~:*~2d~]</td><td>~a</td><td>~a</td><td> ~3a</td><td align=\"right\">~:[~*  ~;~2d~] ~3a</td><td align=\"right\">~4d~:[ &nbsp~;*~] ~{~{</td><td>~2d~c~:[~2*~;~:[~*~;(~:*~c~a)~]~]~}~}</td><td align=\"right\">~2d</td><td align=\"right\">~:[   ~;~:*~3d~]</td><td align=\"right\">~:[   ~;~:*~3d~]</td><td align=\"right\">~:[   ~;~:*~3d~]</td><td align=\"right\">~:[~;~:*~4@d~]</td></tr>"
	      (if (= (spiller-significance spiller) 5) nil (spiller-nr spiller))
	      (spiller-last-name spiller)
	      (spiller-first-name spiller)
	      (home-nationality (first (player-nationality-list 
					(spiller-old-spiller spiller))))
	      (plusp (player-grade-level (spiller-old-spiller spiller)))
	      (player-grade-level (spiller-old-spiller spiller))
	      (player-grade-name (spiller-old-spiller spiller))
	      (if (spiller-u-player spiller)
		  (spiller-rating-change spiller)
		  (player-elo-number (spiller-old-spiller spiller)))
	      (spiller-u-player spiller)
	      (mapcar (lambda (motstander result h-side h-type)
			(list (spiller-nr motstander) 
			      (ecase result 
				(1 #\+)
				(0 #\-)
				(1/2 #\=))
			      *handicap*
			      h-side
			      h-type))
		      (spiller-opponent-rounds spiller)
		      (spiller-result-rounds spiller)
		      (spiller-handicap-side spiller)
		      (spiller-handicap-type spiller))
	      (spiller-pts spiller)
	      (if (>= (spiller-significance spiller) 2)(spiller-sos spiller) nil)
	      (if (>= (spiller-significance spiller) 3)(spiller-sb spiller) nil)
	      (if (>= (spiller-significance spiller) 4)(spiller-cum spiller) nil)
	      (cond ((zerop (player-elo-number (spiller-old-spiller spiller)))
		     nil)
		    (t (spiller-rating-change spiller)))))
    (format f "~%</table>~%")))

(defun skriv3 ()
  (let ((last-name-size 
	 (reduce #'max (mapcar (lambda (spiller)
				 (length (spiller-last-name spiller)))
			       *all*)))
	(first-name-size 
	 (reduce #'max (mapcar (lambda (spiller)
				 (length (spiller-first-name spiller)))
			       *all*))))
    (format t "~2%Nr Name ~vtNat  Grade  ELO  " 
	    (+ last-name-size first-name-size 5))
    (dotimes (r (length (spiller-opponent-rounds (second *all*))))
      (format t " ~2d " (1+ r))
      (when *handicap* (format t "     ")))
    (format t " Pts   +/-")
    (dolist (spiller *all*)
      (format t "~%~2d ~va ~va ~3a ~:[~*  ~;~2d~] ~3a  ~4d~:[ ~;*~] ~{~{~2d~c~:[~2*~;~:[~*     ~;(~:*~c~2a)~]~]~} ~} ~2d  ~:[~;~:*~4@d~]"
	      (spiller-nr spiller)
	      last-name-size
	      (spiller-last-name spiller)
	      first-name-size	      
	      (spiller-first-name spiller)
	      (home-nationality (first (player-nationality-list 
					(spiller-old-spiller spiller))))
	      (plusp (player-grade-level (spiller-old-spiller spiller)))
	      (player-grade-level (spiller-old-spiller spiller))
	      (player-grade-name (spiller-old-spiller spiller))
	      (if (spiller-u-player spiller)
		  (spiller-rating-change spiller)
		  (player-elo-number (spiller-old-spiller spiller)))
	      (spiller-u-player spiller)
	      (mapcar (lambda (motstander result h-side h-type)
			(list (spiller-nr motstander) 
			      (ecase result 
				(1 #\+)
				(0 #\-)
				(1/2 #\=))
			      *handicap*
			      h-side
			      h-type))
		      (spiller-opponent-rounds spiller)
		      (spiller-result-rounds spiller)
		      (spiller-handicap-side spiller)
		      (spiller-handicap-type spiller))
	      (spiller-pts spiller)
	      (if (spiller-u-player spiller)
		  nil
		  (spiller-rating-change spiller))))))

(defun skriv3-html (filename)
  (with-open-file (f filename :direction :output :if-exists :supersede)
    (format f "~%<table>~%<tr><td>Nr</td><td> Name</td><td></td><td>Nat </td><td> Grade </td><td> ELO</td><td>  " )
    (dotimes (r (length (spiller-opponent-rounds (second *all*))))
      (format f "~2d</td><td>" (1+ r)))
    (format f "Pts</td><td>Sb</td><td>+/-</td></tr>")
    (dolist (spiller *all*)
      (format f "~%<tr><td>~:[ =~;~:*~2d~]</td><td> ~a</td><td> ~a</td><td> ~3a</td><td align=\"right\">~:[~*  ~;~2d~] ~3a</td><td align=\"right\">~4d~:[ &nbsp~;*~] ~{~{</td><td>~2d~c~:[~2*~;~:[~*~;(~:*~c~a)~]~]~} ~}</td><td align=\"right\">~2d</td><td align=\"right\">~:[   ~;~:*~3d~]</td><td align=\"right\">~:[~;~:*~4@d~]</td></tr>"
	      (if (>= (spiller-significance spiller) 4) 
		  nil 
		(spiller-nr spiller))
	      (spiller-last-name spiller)
	      (spiller-first-name spiller)
	      (home-nationality (first (player-nationality-list 
					(spiller-old-spiller spiller))))
	      (plusp (player-grade-level (spiller-old-spiller spiller)))
	      (player-grade-level (spiller-old-spiller spiller))
	      (player-grade-name (spiller-old-spiller spiller))
	      (if (spiller-u-player spiller)
		  (spiller-rating-change spiller)
		  (player-elo-number (spiller-old-spiller spiller)))
	      (spiller-u-player spiller)
	      (mapcar (lambda (motstander result h-side h-type)
			 (list (spiller-nr motstander) 
			       (ecase result 
				 (1 #\+)
				 (0 #\-)
				 (1/2 #\=))
			       *handicap*
			       h-side
			       h-type))
		      (spiller-opponent-rounds spiller)
		      (spiller-result-rounds spiller)
		      (spiller-handicap-side spiller)
		      (spiller-handicap-type spiller))
	      (spiller-pts spiller)
	      (if (>= (spiller-significance spiller) 3)
		  (spiller-sb spiller) 
		nil)
	      (cond ((zerop (player-elo-number (spiller-old-spiller spiller)))
		     nil)
		    (t (spiller-rating-change spiller)))))
    (format f "~%</table>~%")))

(defun skriv4-html (filename)
  (with-open-file (f filename :direction :output :if-exists :supersede)
    (format f "~%<table>~%<tr><td>Nr</td><td> Name</td><td></td><td>Nat </td><td> Grade </td><td> ELO</td><td>  " )
    (dotimes (r (length (spiller-opponent-rounds (second *all*))))
      (format f "~2d</td><td>" (1+ r)))
    (format f "Pts</td><td>+/-</td></tr>")
    (dolist (spiller *all*)
      (format f "~%<tr><td>~2d</td><td> ~a</td><td> ~a</td><td> ~3a</td><td align=\"right\">~:[~*  ~;~2d~] ~3a</td><td align=\"right\">~4d~:[ &nbsp~;*~] ~{~{</td><td>~2d~c~:[~2*~;~:[~*~;(~:*~c~a)~]~]~} ~}</td><td align=\"right\">~2d</td><td align=\"right\">~:[~;~:*~4@d~]</td></tr>"
	      (spiller-nr spiller)
	      (spiller-last-name spiller)
	      (spiller-first-name spiller)
	      (home-nationality (first (player-nationality-list 
					(spiller-old-spiller spiller))))
	      (plusp (player-grade-level (spiller-old-spiller spiller)))
	      (player-grade-level (spiller-old-spiller spiller))
	      (player-grade-name (spiller-old-spiller spiller))
	      (if (spiller-u-player spiller)
		  (spiller-rating-change spiller)
		  (player-elo-number (spiller-old-spiller spiller)))
	      (spiller-u-player spiller)
	      (mapcar (lambda (motstander result h-side h-type)
			 (list (spiller-nr motstander) 
			       (ecase result 
				 (1 #\+)
				 (0 #\-)
				 (1/2 #\=))
			       *handicap*
			       h-side
			       h-type))
		      (spiller-opponent-rounds spiller)
		      (spiller-result-rounds spiller)
		      (spiller-handicap-side spiller)
		      (spiller-handicap-type spiller))
	      (spiller-pts spiller)
	      (cond ((zerop (player-elo-number 
			     (spiller-old-spiller spiller)))
		     nil)
		    (t (spiller-rating-change spiller)))))
    (format f "~%</table>~%")))

(defun reorder (berger)
  (when (or (eq *reordering* t)
	    (and (eq *reordering* :undefined)
		 (eql *origin* #\A)))
    (setq *all* (sort *all* #'spiller>=)))
  (let ((nr 0))
    (dolist (spiller *all*)
      (setf (spiller-nr spiller)(incf nr))))
  (mapl (lambda (spillere)
	  (when (> (length spillere) 1)
	    (let ((diff (equalness (first spillere)(second spillere) berger)))
	      (push diff (spiller-significance (first spillere)))
	      (push diff (spiller-significance (second spillere))))))
	*all*)
  (dolist (spiller *all*)
    (format t "~a ~a : ~a~%" 
	    (spiller-last-name spiller)
	    (spiller-first-name spiller)
	    (spiller-significance spiller))
    (setf (spiller-significance spiller)(reduce #'max (spiller-significance spiller)))))


(defun spiller>= (s1 s2)
  (cond ((> (spiller-pts s1)(spiller-pts s2)) t)
	((< (spiller-pts s1)(spiller-pts s2)) nil)
	((> (spiller-sos s1)(spiller-sos s2)) t)
	((< (spiller-sos s1)(spiller-sos s2)) nil)
	((> (spiller-sb s1)(spiller-sb s2)) t)
	((< (spiller-sb s1)(spiller-sb s2)) nil)
	((> (spiller-cum s1)(spiller-cum s2)) t)
	((< (spiller-cum s1)(spiller-cum s2)) nil)
	(t t)))

(defun equalness (s1 s2 berger)
  (cond ((null s2) 1)
	((/= (spiller-pts s1)(spiller-pts s2)) 1)
	((and (not berger)(/= (spiller-sos s1)(spiller-sos s2))) 2)
	((/= (spiller-sb s1)(spiller-sb s2)) 3)
	((and (not berger)(/= (spiller-cum s1)(spiller-cum s2))) 4)
	(t (push 5 (spiller-significance s2))
	   4)))

(defun read-table (&optional (filnavn1 "ratingliste.pre")(filnavn2 "nye-spillere"))
  (with-open-file (f filnavn1 :direction :input)
    (setq *rating* (read f)))
  (with-open-file (f filnavn2 :direction :input :if-does-not-exist nil)
    (when (streamp f)
      (setq *rating* (append (mapcar #'parse-new-player (read f) )
			     *rating*))
      (eval (ignore-errors (read f))))))

(defun write-table (&optional (filnavn "ratingliste.post"))
  (setq *print-pretty* nil)
  (dolist (spiller *all*)
    (incf (player-elo-number (spiller-old-spiller spiller))
	  (spiller-rating-change spiller)))
  (setq *rating* (stable-sort *rating* #'> :key #'player-elo-number))
  (with-open-file (f filnavn :direction :output :if-exists :supersede)
    (format f "(")
    (dolist (x *rating*) (format f "~s~%" x))
    (format f "~%)~%")))

(defun parse-new-player (list-player)
  (make-player :last-name (first list-player)
	       :first-name (second list-player)
	       :nationality-list (third list-player)
	       :nsr-grade-level (fourth list-player)
	       :nsr-grade-name (fifth list-player)
	       :elo-number (sixth list-player)
	       :games (seventh list-player)
	       :last-played (eighth list-player)
	       :lb-count (ninth list-player)
	       :mp-count (tenth list-player)))


(defun find-player (last-name first-name)
  (cond ((find-if (lambda (spiller)
		    (and (string= (player-last-name spiller) last-name)
			 (string= (player-first-name spiller) 
				  first-name)))
		  *rating*))
	(t (error "Unknown player: ~a ~a" last-name first-name))))

(defun find-players ()
  (dolist (spiller *all*)
    (cond ((new-old-spiller spiller (make-player))
	   (setf (spiller-old-spiller spiller)
	     (make-player :last-name "Dummy" :first-name "" 
			  :nationality-list '(#S(HOME :nationality "")) 
			  :grade-level 0 :grade-name "" 
			  :nsr-grade-level 0 :nsr-grade-name ""
			  :games 0 
			  :last-played 0)))
	  ((spiller-simultan-p spiller)
	   (setf (spiller-old-spiller spiller) 
	     (make-player :last-name "" :first-name "" 
			  :nationality-list '(#S(HOME :nationality "")) 
			  :grade-level 0 :grade-name "" 
			  :nsr-grade-level 0 :nsr-grade-name ""
			  :games 0 
			  :last-played 0)))
	  ((setf (spiller-old-spiller spiller)
	     (car (member spiller *rating* :test #'new-old-spiller))))
	  (t (error "Unknown player : ~a ~a" 
		    (spiller-last-name spiller)
		    (spiller-first-name spiller))))))

(defun new-old-spiller (new old)
  (and (string= (spiller-last-name new)
		(player-last-name old))
       (string= (spiller-first-name new)
		(player-first-name old))))

(defun innsats (poeng motstandere &key (dummy nil)(show t))
  (when dummy (incf poeng 1/2))
  (let ((guess (first motstandere))
	(limit 0.001)
	a b k1 k2 modification)
    (loop 
      (setq a 0
	    b 0)
      (dolist (m motstandere)
	(setq k1 (expt 10 (/ (- m guess) 400.0)))
	(setq k2 (/ (1+ k1)))
	(incf a k2)
	(incf b (* k1 k2 k2)))
      (setq modification (/ (- poeng a)
			    (* b (/ (log 10) 400))))
      (cond ((> modification 900)(setq modification 900))
	    ((< modification -900)(setq modification -900)))
      (when (< (abs modification) (incf limit 0.0001))
	(when show
	  (format t " ~d/~d ~a -> ~a"
		  poeng
		  (length motstandere)
		  motstandere
		  (round (+ guess modification))))
	(return-from innsats (round (+ guess modification))))
      (incf guess modification))))

(defun innsats2 (motstander-poeng-k-list &key (show t))
  (let ((guess (first (first motstander-poeng-k-list)))
	(limit 0.001)
	(log10/400 (/ (log 10) 400))
	u1 u2 a b modification)
    (loop
      (setq a 0
	    b 0)
      (dolist (m-p-k motstander-poeng-k-list)
	(setq u1 (expt 10 (/ (- (first m-p-k) guess) 400.0)))
	(setq u2 (/ (1+ u1)))
	(incf a (* (third m-p-k)
		   (- (second m-p-k)
		      u2)))
	(incf b (* (third m-p-k) u1 u2 u2)))
      (setq modification (/ a b log10/400))
      (cond ((> modification 800)(setq modification 800))
	    ((< modification -800)(setq modification -800)))
      (when (< (abs modification)(incf limit 0.0001))
	(when show
	  (format t "~a -> ~a +/- ~,4f" 
		  motstander-poeng-k-list 
		  (round (+ guess modification))
		  limit))
	(return-from innsats2 (max (if *old-rule* 400 1)
				   (round (+ guess modification)))))
      (incf guess modification))))
		  
(defun remove-nth (n list)
  (remove-if (lambda (x) t) list :start n :count 1))

(defun show-players ()
  (dolist (x *all*)
    (simplified-player (spiller-old-spiller x))))

(defun simplified-player (player)
  (format t "~%~a ~a ~a ~a ~a ~a ~a ~a ~a"
	  (player-last-name player)
	  (player-first-name player)
	  (player-grade-level player)
	  (player-grade-name player)
	  (player-elo-number player)
	  (player-games player)
	  (player-last-played player)
	  (player-lb-count player)
	  (player-mp-count player)))


(defparameter *ignore-u/p-k* nil)

(defun +/- ()
  (all-players)
  (inc-games))

(defun all-players ()
  (let ((sumdiff most-positive-fixnum)
        motstander-poenger-k
	spiller-change pre-ant post-ant runder
	dummy-elo bonus beste)
    (dolist (spiller *all*)
       (let ((pre-ant (pre-ant spiller)))
	  (cond ((zerop pre-ant)
		 (when  (plusp (player-nsr-grade-level 
				(spiller-old-spiller spiller)))
		    (setq dummy-elo 
			  (make-dummy 
			   (grade-elo (player-nsr-grade-level 
				       (spiller-old-spiller spiller))
				      (player-nsr-grade-name 
				       (spiller-old-spiller spiller)))))
		    (push (list dummy-elo 1 nil nil)
			  (spiller-clean-motstander-results spiller))
		    (push (list dummy-elo 0 nil nil)
			  (spiller-clean-motstander-results spiller)))
		 (setf (post-ant spiller)(length (spiller-clean-motstander-results spiller)))
		 (setf (spiller-u-player spiller) t)
		 (setf (player-elo-number (spiller-old-spiller spiller)) 
		       0))
		((numberp (player-games (spiller-old-spiller spiller)))
		 (setf (post-ant spiller)
		       (+ pre-ant (length (spiller-clean-motstander-results spiller)))))
		((or (every (lambda (x)(= x 0)) 
			    (mapcar #'second 
				    (player-games (spiller-old-spiller 
						   spiller))))
		     (every (lambda (x)(= x 1)) 
			    (mapcar #'second 
				    (player-games (spiller-old-spiller 
						   spiller))))
		     (zerop (player-elo-number 
			     (spiller-old-spiller spiller)))
		     (< (+ pre-ant 
			   (length (spiller-clean-motstander-results 
				    spiller))) 
			+u-limit+))
		 (dolist (old-result (player-games 
				      (spiller-old-spiller spiller)))
		    (push (list (make-dummy (first old-result)
					    (third old-result))
				(second old-result)
				nil
				nil)
			  (spiller-clean-motstander-results spiller)))
		 (setf (post-ant spiller)
		       (length (spiller-clean-motstander-results 
				spiller)))
		 (setf (spiller-u-player spiller) t)
		 (setf (player-elo-number (spiller-old-spiller spiller)) 
		       0))
		(t (setf (post-ant spiller)
			 (+ pre-ant 
			    (length (spiller-clean-motstander-results 
				     spiller))))))
	  (unless *ignore-u/p-k*
	     (when (< 0 (post-ant spiller) +e-limit+)
		(setf (spiller-u/p-k spiller)
		      (+ 1/2 (/ (post-ant spiller) +e-limit+ 2)))))))
    (loop
      (when (zerop sumdiff) (return))
      (format t "~%~d -> Iterate" sumdiff)
      (setq sumdiff 0)
      (dolist (spiller *all*)
	(setq motstander-poenger-k
	  (get-elo-results spiller))
	(format t "~%~a ~a (~d)" 
		(spiller-last-name spiller)
		(spiller-first-name spiller)
		(player-elo-number (spiller-old-spiller spiller)))
	(setq spiller-change 0)
	(setq pre-ant (pre-ant spiller))
	(cond ((not (spiller-u-player spiller))
	       ;; P+E
	       (dolist (motstander-poeng-k motstander-poenger-k)
		 (format t "~2@d" 
			 (diff (player-elo-number (spiller-old-spiller 
						   spiller))
			       (first motstander-poeng-k)
			       (second motstander-poeng-k)
			       (third motstander-poeng-k)))
		 (incf spiller-change 
		       (diff (player-elo-number (spiller-old-spiller 
						 spiller))
			     (first motstander-poeng-k)
			     (second motstander-poeng-k)
			     (third motstander-poeng-k))))
	       (format t "= ~@d" spiller-change)
	       (setq runder (length (spiller-clean-motstander-results spiller)))
	       (setq bonus
		     (bonus (player-elo-number (spiller-old-spiller 
						spiller))
			    spiller-change
			    (get-elo-results spiller)))
	       (when (< (setq post-ant (post-ant spiller)) +e-limit+)
		  (setq spiller-change
			(round (* +e-limit+ spiller-change) 
			       post-ant))
		  (format t " * ~a/~d = ~@d" 
			  +e-limit+
			  post-ant 
			  spiller-change))
	       (when (plusp bonus)
		 (incf spiller-change bonus)
		 (format t " + (~d) = ~d" bonus spiller-change))
	       (format t " -> ~d" 
		       (+ spiller-change 
			  (player-elo-number (spiller-old-spiller 
					      spiller)))))
	      ((every (lambda (x)(= (second x) 0))
		      (spiller-clean-motstander-results spiller))
	       (format t " 0% -> 1")
	       (setq spiller-change (if *old-rule* 400 1)))
	      ((every (lambda (x)(= (second x) 1))
		      (spiller-clean-motstander-results spiller))
	       (setq beste (copy-list (beste motstander-poenger-k 
					     :key #'first)))
	       (setf (second beste) 1/2)
	       (setq spiller-change 
		     (innsats2 (cons beste 
				     motstander-poenger-k))))
	      (t 
	       (setq spiller-change
		     (innsats2 motstander-poenger-k))))
	(incf sumdiff (kvad (- (spiller-rating-change spiller) 
			       spiller-change)))
	(setf (spiller-rating-change spiller) spiller-change)))))


(defvar *m-handicap* 15)
(defvar *l-handicap* 100)
(defvar *b-handicap* 200)
(defvar *r-handicap* 250)
(defvar *rl-handicap* 350)
(defvar *2p-handicap* 450)
(defvar *4p-handicap* 550)
(defvar *5p-handicap* 750)
(defvar *6p-handicap* 900)		; 1000 in 2000
(defvar *s-handicap* 150)

(defun get-elo-result (result-list)
  (let* ((modification 
	  (cond ((null (fourth result-list))                 0)
		((string-equal "M" (fourth result-list)) *m-handicap*)
		((string-equal "L" (fourth result-list)) *l-handicap*)
		((string-equal "B" (fourth result-list)) *b-handicap*)
		((string-equal "R" (fourth result-list)) *r-handicap*)
		((string-equal "RL" (fourth result-list)) *rl-handicap*)
		((string-equal "2p" (fourth result-list)) *2p-handicap*)
		((string-equal "4p" (fourth result-list)) *4p-handicap*)
		((string-equal "5p" (fourth result-list)) *5p-handicap*)
		((string-equal "6p" (fourth result-list)) *6p-handicap*)
		((string-equal "S" (fourth result-list))  *s-handicap*)
		(t (error "Unknown handicap : ~s" 
			  (fourth result-list)))))
	 (final-modification (case (third result-list)
			       (#\+ (- modification))
			       (#\- (+ modification))
			       (t 0))))
    (list (+ (player-elo-number (spiller-old-spiller (first result-list)))
	     (spiller-rating-change (first result-list))
	     final-modification)
	  (second result-list)
	  (spiller-u/p-k (first result-list)))))
#|
 until 2004-12-31
(defparameter *m-handicap-r*  0.15)
(defparameter *l-handicap-r*  0.50)
(defparameter *b-handicap-r*  1.50)
(defparameter *r-handicap-r*  2.00)
(defparameter *rl-handicap-r* 2.50)
(defparameter *2p-handicap-r* 3.50)
(defparameter *4p-handicap-r* 4.50)
(defparameter *5p-handicap-r* 6.00)
(defparameter *6p-handicap-r* 7.00)
(defparameter *s-handicap-r* 1)
|#

(defparameter *m-handicap-r*  0.20)
(defparameter *l-handicap-r*  0.60)
(defparameter *b-handicap-r*  1.50)
(defparameter *r-handicap-r*  2.10)
(defparameter *rl-handicap-r* 2.70)
(defparameter *2p-handicap-r* 3.60)
(defparameter *4p-handicap-r* 5.00)
(defparameter *5p-handicap-r* 6.50)
(defparameter *6p-handicap-r* 8.00)
(defparameter *s-handicap-r* 1)


(defun get-elo-results-old (spiller)
  (mapcar (lambda (result-list)
	    (get-single-elo-result-old spiller result-list))
	  (spiller-clean-motstander-results spiller)))

(defun get-elo-results-new (spiller)
  (mapcar (lambda (result-list)
	    (get-single-elo-result-new spiller result-list))
	  (spiller-clean-motstander-results spiller)))

(defparameter *old-rule* nil)

(defun get-elo-results (spiller)
  (if *old-rule*
      (get-elo-results-old spiller)
    (get-elo-results-new spiller)))

(defun get-start-rating (spiller)
  (let ((old (player-elo-number (spiller-old-spiller spiller))))
    (if (zerop old)
      (spiller-rating-change spiller)
      old)))

(defun clean-rating-change (spiller)
  (let ((start (player-elo-number (spiller-old-spiller spiller))))
    (if (zerop start) 0
      (spiller-rating-change spiller))))

(defun get-single-elo-result-old (spiller result-list)
  (let* ((my-rating (get-start-rating spiller))
	 (opponent-rating (get-start-rating (first result-list)))
	 (rating-change (clean-rating-change (first result-list)))
	 (modification 
	  (cond ((null (fourth result-list)) 0)
		((string-equal "M" (fourth result-list)) *m-handicap-r*)
		((string-equal "L" (fourth result-list)) *l-handicap-r*)
		((string-equal "B" (fourth result-list)) *b-handicap-r*)
		((string-equal "R" (fourth result-list)) *r-handicap-r*)
		((string-equal "RL" (fourth result-list)) *rl-handicap-r*)
		((string-equal "2p" (fourth result-list)) *2p-handicap-r*)
		((string-equal "4p" (fourth result-list)) *4p-handicap-r*)
		((string-equal "5p" (fourth result-list)) *5p-handicap-r*)
		((string-equal "6p" (fourth result-list)) *6p-handicap-r*)
		((string-equal "S" (fourth result-list))  *s-handicap-r*)
		(t (error "Unknown handicap : ~s" (fourth result-list)))))
	 (effective-opponent-rating
	  (case (third result-list)
	    (#\+ (ranknr-elo (- (elo-ranknr opponent-rating) 
				modification)))
	    (#\- (+ opponent-rating
		    (- my-rating
		       (ranknr-elo (- (elo-ranknr my-rating) 
				      modification)))))
	    (t opponent-rating))))
    (list (+ effective-opponent-rating 
	     (clean-rating-change (first result-list)))
	  (second result-list)
	  (spiller-u/p-k (first result-list)))))

(defun get-single-elo-result-new (spiller result-list)
  (let* ((my-rating (get-start-rating spiller))
	 (rating-change (clean-rating-change (first result-list)))
	 (opponent-rating (max 400
			       (+ (get-start-rating (first result-list))
				  rating-change)))
	 (modification 
	  (cond ((null (fourth result-list)) 0)
		((string-equal "M" (fourth result-list)) *m-handicap-r*)
		((string-equal "L" (fourth result-list)) *l-handicap-r*)
		((string-equal "B" (fourth result-list)) *b-handicap-r*)
		((string-equal "R" (fourth result-list)) *r-handicap-r*)
		((string-equal "RL" (fourth result-list)) *rl-handicap-r*)
		((string-equal "2p" (fourth result-list)) *2p-handicap-r*)
		((string-equal "4p" (fourth result-list)) *4p-handicap-r*)
		((string-equal "5p" (fourth result-list)) *5p-handicap-r*)
		((string-equal "6p" (fourth result-list)) *6p-handicap-r*)
		((string-equal "S" (fourth result-list))  *s-handicap-r*)
		(t (error "Unknown handicap : ~s" (fourth result-list)))))
	 (effective-opponent-rating
	  (case (third result-list)
	    (#\+ (ranknr-elo (- (elo-ranknr opponent-rating) 
				modification)))
	    (#\- (+ opponent-rating
		    (- my-rating
		       (ranknr-elo (- (elo-ranknr my-rating) 
				      modification)))))
	    (t opponent-rating))))
    (list effective-opponent-rating
	  (second result-list)
	  (spiller-u/p-k (first result-list)))))

(defun inc-games ()
  (dolist (spiller *all*)
    (setf (player-games (spiller-old-spiller spiller))
      (if (spiller-u-player spiller)
	  (get-elo-results spiller)
	(post-ant spiller)))
    (setf (player-last-played (spiller-old-spiller spiller)) *date*)
    (let ((home-ob (find *origin* (player-nationality-list 
				   (spiller-old-spiller spiller)) 
			 :key #'home-list)))
      (unless home-ob
	(setq home-ob (copy-home (first (player-nationality-list 
					 (spiller-old-spiller spiller)))))
	(setf (home-list home-ob) *origin*)
	(push home-ob (player-nationality-list (spiller-old-spiller spiller))))
      (setf (home-last home-ob) *date*))
    (when *counting*  
      (register (+ (player-elo-number (spiller-old-spiller spiller))
		   (spiller-rating-change spiller))
		(length (remove-if (lambda (x) (eq x *dummy*)) 
				   (spiller-opponent-rounds spiller)))
		*origin*
		(and (not (spiller-u-player spiller))
		     (>= (post-ant spiller) +e-limit+))))))
     

(defvar *special-promotions* nil)
(defvar *delayed-promotions* nil)

(defun special-promotions ()
  (dolist (promotion *special-promotions*)
    (let ((player (find-player (first promotion)(second promotion))))
      (setf (player-nsr-grade-level player)(third promotion)
	    (player-nsr-grade-name player)(fourth promotion))))
  (setq *special-promotions* nil))

(defun special-promotions-old ()
  (dolist (promotion *special-promotions*)
    (let ((player (find-player (first promotion)(second promotion))))
      (setf (player-grade-level player)(third promotion)
	    (player-grade-name player)(fourth promotion))))
  (setq *special-promotions* nil))

(defun delayed-promotions ()
  (dolist (promotion *delayed-promotions*)
    (let ((player (find-player (first promotion)(second promotion))))
      (setf (player-nsr-grade-level player)(third promotion)
	    (player-nsr-grade-name player)(fourth promotion))))
  (setq *delayed-promotions* nil))

(defun special-promotion (last-name first-name value type)
  (push (list last-name first-name value type)
	*special-promotions*))

(defun delay-promotion (last-name first-name value type)
  (push (list last-name first-name value type)
	*delayed-promotions*))
  
(defun empty-simultan ()
  (dolist (spiller *all*)
    (when (spiller-simultan-p spiller)
      (setf (spiller-opponent-rounds spiller) nil
	    (spiller-result-rounds spiller) nil
	    (spiller-handicap-side spiller) nil
	    (spiller-handicap-type spiller) nil))))

(defun elo-k (elo)
  (cond ((>= elo (lb 5 "Dan")) 16)
	((>= elo (lb 3 "Dan")) 20)
	((>= elo (lb 1 "Kyu")) 24)
	((>= elo (lb 4 "Kyu")) 28)
	((>= elo (lb 7 "Kyu")) 32)
	((>= elo (lb 11 "Kyu")) 36)
	(t 40)))

(defun diff (my opponent result &optional (modification 1))
  (let ((k (* modification (elo-k my))))
    (round (* k (- result (/ (1+ (expt 10 (/ (- opponent my) 
					     400.0d0)))))))))

(defun kvad (x)(* x x))

(defun bonus (rating increase games)
   (let* ((ant-games (length games))
	  (score (reduce #'+ games :key #'second))
	  (bonus (- increase 20 (* 3 ant-games)))
	  (limit (if (or (= score ant-games) 
			 (zerop score)
			 (<= bonus 0))
		     9999
		     (- (innsats score (mapcar #'first games) :show nil)
			rating))))
     (when (plusp bonus)
       (format t "~%Max bonus-k = ~a~%" (/ (- limit increase))))
     (when (> bonus limit 0)
       (format t "~%Bonus limited to performance rating")
       (setq bonus limit))
     (setq bonus (if (> bonus 0) (round bonus) 0))
     bonus))

(defun bonus (rating increase games)
   (let* ((ant-games (length games))
	  (score (reduce #'+ games :key #'second))
	  (bonus (- increase 20 (* 3 ant-games)))
	  (limit (if (or (= score ant-games) 
			 (zerop score)
			 (<= bonus 0))
		     9999
		     (- (innsats score (mapcar #'first games) :show nil)
			rating))))
     (when (and *super-bonus-active* (plusp bonus))
       (setq bonus (* bonus (1- (/ 25 ant-games)))))
     (when (> bonus limit 0)
       (format t "~%Bonus limited to performance rating")
       (setq bonus limit))
     (setq bonus (if (> bonus 0) (round bonus) 0))
     bonus))

;;                            1    2    3    4    5    6    7    8   9  10  11  12  13  14  15  16  17  18  19 20

(defparameter *dan-mp* '(0 1740 1860 2000 2160 2340 2540 2760 3000 9999 9999))
(defparameter *dan-lb* '(0 1680 1800 1920 2080 2240 2440 2640 2880 3120 9999))

(defparameter *kyu-mp* '(0 1620 1510 1410 1320 1240 1160 1080 1000 920 840 760 680 600 520 440 360 280 200 120 40))
(defparameter *kyu-lb* '(0 1560 1460 1360 1280 1200 1120 1040  960 880 800 720 640 560 480 400 320 240 160  80  0))

(defparameter *dan-lb-#* '(0 14   14   16   16 9999 9999 9999))
(defparameter *dan-mp-#* '(0  7    7    8    8   10 9999 9999))

(defparameter *kyu-lb-#* '(0 14   12   12   12   10   10   10    8   8   8   8   6   6   6   6   6   6   6   6   6))
(defparameter *kyu-mp-#* '(0  7    6    6    6    5    5    5    4   4   4   4   3   3   3   3   3   3   3   3   3))

(defun grade-elo (value type)
   (cond ((string-equal type "Dan")
	  (nth value *dan-mp*))
	 ((string-equal type "Kyu")
	  (nth value *kyu-mp*))
	 ((string-equal type "Pro") 
	  (+ (- 2540 30) (* 30 value)))
	 (t (error "Unknown rating type : ~a" type))))

(defun lb (value type)
  (cond ((string-equal type "Pro") 9999)
	((string-equal type "Dan")(nth value *dan-lb*))
	((string-equal type "Kyu")(nth value *kyu-lb*))
	(t (error "Unknown grade ~a ~a" value type))))

(defun mp (value type)
  (cond ((string-equal type "Pro") 9999)
	((string-equal type "Dan")(nth value *dan-mp*))
	((string-equal type "Kyu")(nth value *kyu-mp*))
	(t (error "Unknown grade ~a ~a" value type))))

(defun ub (value type)
  (let ((next-grade (next-grade value type)))
    (lb (first next-grade)(second next-grade))))

(defun next-lb (value type)
  (ub value type))

(defun next-mp (value type)
  (let ((next-grade (next-grade value type)))
    (mp (first next-grade)(second next-grade))))

(defun next-ub (value type)
  (let ((next-grade (next-grade value type)))
    (ub (first next-grade)(second next-grade))))

(defun next-grade (value type)
  (cond ((string-equal type "Pro")(list 0 "Pro"))
	((string-equal type "Dan")(list (1+ value) type))
	((string-equal type "")(list 20 "Kyu"))
	((string-not-equal type "Kyu")(error "No next-grad for ~s" type))
	((= 1 value)(list 1 "Dan"))
	(t (list (1- value) type))))

(defun limit-mp (value type)
  (cond ((string-equal type "Pro") 9999)
	((string-equal type "Dan")(nth value *dan-mp-#*))
	((string-equal type "Kyu")(nth value *kyu-mp-#*))
	(t (error "Unknown grade ~a ~a" value type))))

(defun limit-lb (value type)
  (cond ((string-equal type "Pro") 9999)
	((string-equal type "Dan")(nth value *dan-lb-#*))
	((string-equal type "Kyu")(nth value *kyu-lb-#*))
	(t (error "Unknown grade ~a ~a" value type))))
  
(defun find-promotions ()
  (dolist (spiller *all*)
    (unless (spiller-simultan-p spiller)
      (let* ((spiller-stat (spiller-old-spiller spiller))
	     (from (player-elo-number spiller-stat))
	     (to (+ from (spiller-rating-change spiller)))
	     (from (if (= 0 from) to from))
	     (games (length (spiller-clean-motstander-results spiller)))
	     (tot-games (pre-ant spiller)) ;pre-ant til neste turnering
	     (inc (ignore-errors (/ (- to from) games))))
	;; (format t "~%~a ~a ~a ~a" from to games spiller-stat)
	(do ((round 1 (1+ round))
	     (s-tot (1+ (- tot-games games)) (1+ s-tot))
	     (rating (ignore-errors (+ from inc))(+ rating inc)))
	    ((> round games))
	  (cond ((>= s-tot +e-limit+)
		 (test-promotion rating spiller-stat round))
		((>= s-tot +u-limit+)
		 (test-p-promotion rating spiller-stat round))))
	(when (>= tot-games +e-limit+)
	  (let ((cur-grade-value (player-grade-level spiller-stat))
		(cur-grade-type (player-grade-name spiller-stat))
		(old-spiller-stat (copy-tree spiller-stat)))
	    (setq spiller-stat (copy-player spiller-stat))
	    (setf (player-lb-count spiller-stat)
	      (copy-list (player-lb-count spiller-stat)))
	    (setf (player-mp-count spiller-stat)
	       (copy-list (player-mp-count spiller-stat)))
	    (do ((round (1+ games) (1+ round))
		 (s-tot (1+ tot-games) (1+ s-tot))
		 (rating (- to (elo-k to)) (- rating (elo-k rating))))
		((> round (+ games 20)))
	      (cond ((>= s-tot +e-limit+)
		     (test-promotion rating spiller-stat round))
		    ((>= s-tot +u-limit+)
		     (error "Dette er umulig")
		     (test-p-promotion rating spiller-stat round))))
	    (unless (and (= cur-grade-value 
			    (player-grade-level spiller-stat))
			 (string= cur-grade-type 
				  (player-grade-name spiller-stat)))
	      (promote (spiller-old-spiller spiller)))))))))
		  
(defun test-promotion (rating spiller-stat round)
  (let* ((grade-value (player-grade-level spiller-stat))
	 (grade-type (player-grade-name spiller-stat))
	 (next-lb (next-lb grade-value grade-type))
	 (next-mp (next-mp grade-value grade-type))
	 (next-ub (next-ub grade-value grade-type)))
    (cond ((>= rating next-ub)
	   (format t "~%~a ~a : Upper bound reached in game ~a" 
		   (player-last-name spiller-stat)
		   (player-first-name spiller-stat) round)
	   (promote spiller-stat)
	   (test-promotion rating spiller-stat round))
	  ((>= rating next-mp)
	   (format t "~%~a ~a: Registering one game above MP in game ~a"
		   (player-last-name spiller-stat)
		   (player-first-name spiller-stat) round)
	   (cond ((eq :mp (first (player-mp-count spiller-stat)))
		  (incf (second (player-lb-count spiller-stat)))
		  (incf (second (player-mp-count spiller-stat))))
		 ((eq :lb (first (player-lb-count spiller-stat)))
		  (incf (second (player-lb-count spiller-stat)))
		  (setf (third (player-lb-count spiller-stat)) t)
		  (setf (player-mp-count spiller-stat) (list :mp 1)))
		 (t (setf (player-lb-count spiller-stat) (list :lb 1 t) 
			  (player-mp-count spiller-stat) (list :mp 1))))
	   (above-limit? spiller-stat rating round 
			 grade-value grade-type))
	  ((>= rating next-lb)
	   (format t "~%~a ~a: Registering one game above LB in game ~a"
		   (player-last-name spiller-stat)
		   (player-first-name spiller-stat) round)
	   (cond ((eq :lb (first (player-lb-count spiller-stat)))
		  (setf (player-mp-count spiller-stat) nil)
		  (incf (second (player-lb-count spiller-stat))))
		 (t (setf (player-lb-count spiller-stat) (list :lb 1 nil)
			  (player-mp-count spiller-stat) nil)))
	   (above-limit? spiller-stat rating round 
			 grade-value grade-type))
	  (t (setf (player-lb-count spiller-stat) nil
		   (player-mp-count spiller-stat) nil)))))

(defun test-p-promotion (rating spiller-stat round)
   (let* ((old-grade-value (player-grade-level spiller-stat))
	  (old-grade-type (player-grade-name spiller-stat))
	  (next-grade (next-grade old-grade-value old-grade-type))
	  (grade-value (first next-grade))
	  (grade-type (second next-grade))
	  (next-ub (next-ub grade-value grade-type)))
      (when (>= rating next-ub)
	 (format t "~%~a ~a : Upper bound+1 reached in game ~a" 
		 (player-last-name spiller-stat)
		 (player-first-name spiller-stat) 
		 round)
	 (promote spiller-stat)
	 (test-p-promotion rating spiller-stat round))))


(defun above-limit? (spiller-stat rating round grade-value grade-type)
   (let ((next-grade (next-grade grade-value grade-type)))
      (when (and (player-lb-count spiller-stat)
		 (or (and (>= (second (player-lb-count spiller-stat))
			      (limit-lb (first next-grade)(second next-grade)))
			  (third (player-lb-count spiller-stat)))
		     (and (player-mp-count spiller-stat)
			  (>= (second (player-mp-count spiller-stat))
			      (limit-mp (first next-grade)(second next-grade))))))
	 (promote spiller-stat)
	 (test-promotion rating spiller-stat round))))
		    
(defun promote (spiller-stat)
  (let* ((next-grade (next-grade (player-grade-level spiller-stat)
				 (player-grade-name spiller-stat))))
    (format t "~%Promoting ~a ~a to ~d ~a" 
	    (player-last-name spiller-stat)
	    (player-first-name spiller-stat)
	    (first next-grade)
	    (second next-grade))
    (setf (player-grade-level spiller-stat) (first next-grade)
	  (player-grade-name spiller-stat) (second next-grade)
	  (player-lb-count spiller-stat) nil
	  (player-mp-count spiller-stat) nil)))


(defun show-all (date)
  (show-list *rating* date))

(defun show-list (list date)
  (with-open-file (f "all.txt" :direction :output :if-exists :supersede)
    (format f "Elo list for ~a~2%" date)
    (format f "    Name                               Grades       Elo #games Nationality")
    (let ((teller 0)
	  exists)
      (dolist (spiller list)
	(when (active-player (player-last-played spiller) date)
	  (unless (or (string-equal (player-grade-name spiller) "Pro")
		      (string-equal (player-nsr-grade-name spiller) "Pro"))
	    (format f "~%~3d ~17a ~15a ~[  ~:;~:*~2d~] ~3a ~[  ~:;~:*~2d~] ~3a ~4d ~3d"
		    (incf teller)
		    (player-last-name spiller)
		    (player-first-name spiller)
		    (player-grade-level spiller)
		    (player-grade-name spiller)
		    (player-nsr-grade-level spiller)
		    (player-nsr-grade-name spiller)
		    (player-elo-number spiller)
		    (game-number (player-games spiller)))
	    (simple-nationality spiller f)))))))

(defun show-list-ec ()
  (with-open-file (f "ec.txt" :direction :output :if-exists :supersede)
    (let ((teller 0)
	  (sorted-players (sort (copy-list *rating*) #'string< 
				:key (lambda (player)
				       (format nil "~a ~a"
					       (player-last-name player)
					       (player-first-name player)))))
	  exists)
      (dolist (spiller sorted-players)
	(format f "~%~a ~a ~[ ~:;~:*~d~] ~a ~[ ~:;~:*~d~] ~a ~d ~a ~a ~a"
		(player-last-name spiller)
		(player-first-name spiller)
		(player-grade-level spiller)
		(player-grade-name spiller)
		(player-nsr-grade-level spiller)
		(player-nsr-grade-name spiller)
		(player-elo-number spiller)
		(player-games spiller)
		(player-nationality-list spiller)
		(player-last-played spiller))))))


(defun simple-nationality (spiller stream)
  (let ((a-value (find #\A (player-nationality-list spiller) 
		       :key #'home-list))
	(e-value (find #\E (player-nationality-list spiller) 
		       :key #'home-list)))
    (cond (a-value (format stream "    ~a" (home-nationality a-value)))
	  (e-value (format stream "    ~a" (home-nationality e-value))))))

	      
(defun active-p (d1 d2)
  (cond ((string= d1 "") t)
	(t (string>= d1 d2 :end2 (length d1)))))

(defun active-player (last-played today)
  (when (= 0 (length last-played)) (setq last-played "2000-01-01"))
  (when (= 7 (length last-played)) (setq last-played (format nil "~a-31" last-played)))
  (when (= 7 (length today)) (setq today (format nil "~a-31" today)))
  (unless (= 10 (length last-played)) (error "~a is not an ok date" last-played))
  (unless (= 10 (length today)) (error "~a is not an ok date" today))
  (let ((2-years-ago (format nil "~4d~a" 
			     (- (parse-integer (subseq today 0 4)) 2) 
			     (subseq today 4))))
    (string<= 2-years-ago last-played)))
    

(defun game-number (x)
  (if (listp x)(length x) x))



#|

     In one e-mail I sent a list of proposed values for pros.  It may
need adjustment since we made other changes.  For a simple rule, a Pro
1 Dan is considered equal to Amateur six dan (i.e. 2540), and each
step above that is another 30 points.  So Pro 2 Dan = 2570, 3 Dan
=2600, C2 or free class pro 2630, C1 2660, B2 2690, B1 2720, A class
or titleholder 2750, Meijin or multiple title holder 2780.  I propose
to add this to the document. Comments?

|#

(defvar *accumulated-handicap-results* (make-hash-table :test #'equalp))

(defun initiate-handicap-results ()
  (clrhash *accumulated-handicap-results*)
  (dolist (handicap-type '("M" "L" "B" "R" "RL" "2p" "4p" "5p" "6p"))
    (dolist (direction (list #\+ #\-))
      (setf (gethash (list direction handicap-type) *accumulated-handicap-results*) 
	(list 0 0))))
  (setf (gethash (list nil nil) *accumulated-handicap-results*) (list 0 0)))

(defun show-handicap-results ()
  (let ((result (gethash (list nil nil) *accumulated-handicap-results*)))
    (format t "~%*** ~4d / ~2d = ~5,1f"
	    (first result) 
	    (second result)
	    (or (ignore-errors (/ (first result) (second result)))
		0)))
  (dolist (handicap-type '("M" "L" "B" "R" "RL" "2p" "4p" "5p" "6p"))
    (dolist (direction (list #\+ #\-))
      (let ((result (gethash (list direction handicap-type) *accumulated-handicap-results*)))
	(format t "~%~a~2a ~4d / ~2d = ~5,1f" 
		direction 
		handicap-type 
		(first result) 
		(second result)
		(or (ignore-errors (/ (first result) (second result)))
		    0))))))


(defun update-handicap-scores ()
  (dolist (spiller *all*)
    (mapc (lambda (type basics)
	    (when (or (and (char= (caddr type) #\+)
			   (handicap-e-player (first type)))
		      (and (char= (caddr type) #\-)
			   (handicap-e-player spiller)))
	      (let ((place (gethash (cddr type) 
				    *accumulated-handicap-results*)))
		(unless place (error "Unknown handicap type : ~a" 
				     (cdr type)))
		(incf (first place)
		      (diff (- (player-elo-number (spiller-old-spiller 
						   spiller)) 
			       10000)
			    (- (first basics) 10000)
			    (second basics)))
		(incf (second place)))))
	  (spiller-clean-motstander-results spiller)
	  (get-elo-results spiller))))

(defun elo-ranknr (elo)
  (cond ((> elo (nth 1 *dan-lb*))
	 :dan-grade
	 (let ((main-nr (position elo (rest *dan-lb*) :test #'<)))
	   (+ 14.0 main-nr (part-of elo
				   (nth main-nr *dan-lb*)
				   (nth (1+ main-nr) *dan-lb*)))))
	((> elo (nth 1 *kyu-lb*))
	 :1-kyu-grad
	 (+ 14.0 (part-of elo 
			(nth 1 *kyu-lb*)
			(nth 1 *dan-lb*))))
	(t :kyu-grade
	   (let ((main-nr (position elo (rest *kyu-lb*) :test #'>)))
	     (if main-nr
		 (+ (- 14.0 main-nr)
		    (part-of elo 
			     (nth (1+ main-nr) *kyu-lb*) 
			     (nth main-nr *kyu-lb*)))
	       0.0)))))

(defun part-of (x lb ub)
  (/ (- x lb)
     (- ub lb)))

(defun ranknr-elo (nr)
  (multiple-value-bind (main-nr part) (floor nr)
    (round 
     (cond ((>= main-nr 15)
	    (value-of part 
		      (nth (- main-nr 14) *dan-lb*)
		      (nth (- main-nr 13) *dan-lb*)))
	   ((= main-nr 14)
	    (value-of part
		      (nth 1 *kyu-lb*)
		      (nth 1 *dan-lb*)))
	   ((>= main-nr -5)
	    (value-of part 
		      (nth (- 15 main-nr) *kyu-lb*)
		      (nth (- 14 main-nr) *kyu-lb*)))
	   (t 1)))))

(defun value-of (part lb ub)
  (+ lb (* part (- ub lb))))

(defun show-handicap-effects (elo)
  (dolist (x `(("Lance" ,*l-handicap-r*)
	       ("Bishop" ,*b-handicap-r*)
	       ("Rook" ,*r-handicap-r*)
	       ("Rook-Lance" ,*rl-handicap-r*)
	       ("2piece" ,*2p-handicap-r*)
	       ("4 piece" ,*4p-handicap-r*)
	       ("5 piece" ,*5p-handicap-r*)
	       ("6 piece" ,*6p-handicap-r*)))
    (format t "~%~12a ~4d" (first x) (ranknr-elo (- (elo-ranknr elo) (second x))))))

(defvar *counting* nil)
(defvar *counting-stat* nil)
(defvar *count-not-established* nil)

(defun start-registrer ()
  (setq *counting* t)
  (setq *counting-stat* nil))

(defun register (rating ant origin established)
  (when (or established *count-not-established*)
    (let ((place (assoc origin *counting-stat*)))
      (unless place (push (setq place (list origin 0 0 0)) *counting-stat*))
      (incf (second place) ant)
      (incf (third place) (* ant rating))
      (incf (fourth place) (* ant rating rating)))))

(defun show-register ()
  (dolist (results *counting-stat*)
    (format t "~%~a : Ant= ~d  Avg= ~d  Sd= ~d" 
	    (first results)
	    (second results)
	    (round (/ (third results) (second results)))
	    (round (sqrt (/ (- (fourth results) (/ (kvad (third results)) 
						   (second results)))
			    (1- (second results))))))))


(defun stop-register ()
  (setq *counting* nil))

(defun show-dates ()
  (with-open-file (f "rating-dates.txt" :direction :output :if-exists :supersede 
		   :if-does-not-exist :create)
    (dolist (player *rating*)
      (format f "~a ~a ~a ~a ~a (~a ~a)~%" 
	      (player-last-name player)
	      (player-first-name player)
	      (player-elo-number player)
	      (game-number (player-games player))
	      (player-last-played player)
	      (ignore-errors (home-last (find #\E (player-nationality-list player) 
					      :key #'home-list)))
	      (ignore-errors (home-last (find #\A (player-nationality-list player) 
					      :key #'home-list)))))))




(defun run-perform (level &key (clean nil))
  (setq *print-circle* t)
  (setq *handicap* nil)
  (les "turnering.txt")
  (calculate)
  (read-table)
  (find-players)
  (when clean
    (dolist (spiller *all*)
      (setf (player-elo-number (spiller-old-spiller spiller)) 1000)))
  (dolist (spiller *all*) 
    (setf (spiller-rating-change spiller)
      (list (player-elo-number (spiller-old-spiller spiller)))))
  (dotimes (x level) (find-performance))
  (show-performance))

(defun find-performance-old ()
  (dolist (spiller *all*)
    (let ((poeng 1/2)
	  (opponents (list (player-elo-number 
			    (spiller-old-spiller spiller)))))
      (dolist (round (spiller-clean-motstander-results spiller))
	(incf poeng (second round))
	(push (player-elo-number 
	       (spiller-old-spiller (first round)))
	      opponents))
      (push (setf (player-elo-number (spiller-old-spiller spiller))
	      (innsats poeng opponents))
	    (spiller-rating-change spiller)))))

(defun find-performance ()
  (let ((res (mapcar (lambda (spiller)
		       (let ((poeng 1/2)
			     (opponents (list (player-elo-number 
					       (spiller-old-spiller spiller)))))
			 (dolist (round (spiller-clean-motstander-results 
					 spiller))
			   (incf poeng (second round))
			   (push (player-elo-number 
				  (spiller-old-spiller (first round)))
				 opponents))
			 (innsats poeng opponents)))
		     *all*)))
    (mapc (lambda (spiller res)
	    (push res (spiller-rating-change spiller))
	    (setf (player-elo-number (spiller-old-spiller spiller)) res))
	  *all* res)))

(defun show-performance-old ()
  (let ((last-name-size (reduce #'max 
				(mapcar (lambda (spiller)
					  (length (spiller-last-name spiller)))
					*all*)))
	(first-name-size (reduce #'max 
				 (mapcar (lambda (spiller)
					   (length (spiller-first-name spiller)))
					 *all*))))
    (dolist (spiller *all*)
      (format t "~%~va ~va ~4d" 
	      last-name-size
	      (spiller-last-name spiller)
	      first-name-size	      
	      (spiller-first-name spiller)
	      (player-elo-number (spiller-old-spiller spiller))))))

(defun show-performance ()
  (let ((last-name-size 
	 (reduce #'max (mapcar (lambda (spiller)
				 (length (spiller-last-name spiller)))
			       *all*)))
	(first-name-size 
	 (reduce #'max (mapcar (lambda (spiller)
				 (length (spiller-first-name spiller)))
			       *all*))))
    (format t "~2%Nr Name ~vt ELO" 
	    (+ last-name-size first-name-size 5))
    (dotimes (r (length (spiller-opponent-rounds (second *all*))))
      (format t " ~2d " (1+ r))
      (when *handicap* (format t "     ")))
    (format t " Pts  Perform")
    (dolist (spiller *all*)
      (format t "~%~2d ~va ~va ~4d ~{~{~2d~c~:[~2*~;~:[~*     ~;(~:*~c~2a)~]~]~} ~} ~2d  ~{~4d ~}"
	      (spiller-nr spiller)
	      last-name-size
	      (spiller-last-name spiller)
	      first-name-size	      
	      (spiller-first-name spiller)
	      (car (last (spiller-rating-change spiller)))
	      (mapcar (lambda (motstander result h-side h-type)
			(list (spiller-nr motstander) 
			      (ecase result 
				(1 #\+)
				(0 #\-)
				(1/2 #\=))
			      *handicap*
			      h-side
			      h-type))
		      (spiller-opponent-rounds spiller)
		      (spiller-result-rounds spiller)
		      (spiller-handicap-side spiller)
		      (spiller-handicap-type spiller))
	      (spiller-pts spiller)
	      (rest (reverse (spiller-rating-change spiller)))))))


#|

For komplisert


(defun find-performance (rounds)
  (let (old)
    (dotimes (round rounds)
      (dolist (spiller *all*)
	(format t ".")
	(setq old (spiller-old-spiller spiller))
	(format t ",")
	(setf (player-games old)
	  (if (or (null (player-elo-number old))
		  (= 1 (player-elo-number old)))
	      nil
	    (list (list (player-elo-number old)
			1/2 1)))))
      (+/-)
      (dolist (spiller *all*
      (?))))))
   

|#