[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master f8771e9: * packages/arbitools/arbitools.el: Various code t
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] master f8771e9: * packages/arbitools/arbitools.el: Various code tweaks |
|
Date: |
Fri, 10 May 2019 15:55:45 -0400 (EDT) |
branch: master
commit f8771e9b578495c8aab5d37e550eae325ad2e50d
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
* packages/arbitools/arbitools.el: Various code tweaks
Silence compiler warnings when compiling with lexical-binding,
mostly by removing unused variables.
Remove redundant `save-excursion` around `with-current-buffer`.
(arbitools-fill-players-info): Don't use `add-to-list` on local vars.
(arbitools-calculate-points): Don't repeatedly call thing-at-point.
(arbitools-get-player-opponents): Avoid let-binding `maxlength` and
`numberofrounds` to dummy initial values only to immediately set them.
Use the loop's index variable instead of computing it by hand in
`roundcount`. Don't use `add-to-list` on local vars.
(arbitools-get-player-played-points): Simplify with DeMorgan's
(AND (not A) (not B)) == (not (or A B)), and then consolidate
(or (= x ..) (= x ..) ...) into a `member` test.
Use the loop's index variable instead of computing it by hand in
`roundcount`.
(arbitools-get-player-performance): Use the loop's index variable
instead of computing it by hand in `roundcount`.
(arbitools-calculate-arpo): Use the loop's index variable instead of
computing it by hand in `roundcount`. Also use `member`.
---
packages/arbitools/arbitools.el | 665 ++++++++++++++++++++--------------------
1 file changed, 337 insertions(+), 328 deletions(-)
diff --git a/packages/arbitools/arbitools.el b/packages/arbitools/arbitools.el
index e08e7d0..0075d06 100644
--- a/packages/arbitools/arbitools.el
+++ b/packages/arbitools/arbitools.el
@@ -1,6 +1,6 @@
;;; arbitools.el --- Package for chess tournaments administration
-;; Copyright 2016 Free Software Foundation, Inc.
+;; Copyright 2016-2019 Free Software Foundation, Inc.
;; Author: David Gonzalez Gandara <address@hidden>
;; Version: 0.975
@@ -17,7 +17,7 @@
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -30,8 +30,8 @@
;; It is distributed under a GPL license.
;; https://www.tug.org/applications/pdftex/
;;
-;; "bbpPairings.exe" by Bierema Boyz Programming is necessary to do the
-;; pairings. Copy the file to an executable folder,
+;; "bbpPairings.exe" by Bierema Boyz Programming is necessary to do the
+;; pairings. Copy the file to an executable folder,
;; for example /usr/bin.
;; Find bbpPairings in
;; https://github.com/BieremaBoyzProgramming/bbpPairings
@@ -50,11 +50,11 @@
;; manual edition of the files.
;;
;; - Updating the players ratings. - with python
-;;
+;;
;; - Adding players to an existing file. - with python
;;
;; - Getting standings from a tournament file. -with python
-;;
+;;
;; - Getting IT3 Tournament report form. - with python
;;
;; - Deleting a round. - Native
@@ -111,14 +111,17 @@
(defvar arbitools-elo-floor 1000)
(defvar arbitools-arpo-cutworst t)
(defvar arbitools-arpo-cutbest t)
-(defvar arbitools-performancetable (list -800 -677 -589 -538 -501 -470 -444
-422 -401 -383 -366 -351 -336 -322 -309 -296 -284 -273 -262 -251 -240 -230 -220
-211 -202 -193 -184 -175 -166 -158 -149 -141 -133 -125 -117 -110 -102 -95 -87
-80 -72 -65 -57 -50 -43 -36 -29 -21 -14 -7 0 7 14 21 29 36 43 50 57 65 72 80 87
95 102 110 117 125 133 141 149 158 166 175 184 193 202 211 220 230 240 251 262
273 284 296 309 322 336 351 366 383 401 422 444 470 501 538 589 677 800))
+(defvar arbitools-performancetable (list -800 -677 -589 -538 -501 -470 -444
-422 -401 -383 -366 -351 -336 -322 -309 -296 -284 -273 -262 -251 -240 -230 -220
-211 -202 -193 -184 -175 -166 -158 -149 -141 -133 -125 -117 -110 -102 -95 -87
-80 -72 -65 -57 -50 -43 -36 -29 -21 -14 -7 0 7 14 21 29 36 43 50 57 65 72 80 87
95 102 110 117 125 133 141 149 158 166 175 184 193 202 211 220 230 240 251 262
273 284 296 309 322 336 351 366 383 401 422 444 470 501 538 589 677 800)
+ ;; FIXME: A docstring explaining what this is (where it comes from, what's
+ ;; it's useful for, ...) would be helpful.
+ )
(defvar arbitools-players-info nil)
;; TODO Implement a hashtable to parse the file and store the data
;; TODO Implement the performance table as a vector variable
(defun arbitools-fill-players-info ()
- "Fill arbitools-players-info with the information from the main buffer"
+ "Fill `arbitools-players-info' with the information from the main buffer"
(save-excursion
(goto-char (point-min))
(setq arbitools-players-info nil)
@@ -127,92 +130,93 @@
(rankstring (substring-no-properties linestring 5 8))
(namestring (substring-no-properties linestring 14 47))
(elostring (substring-no-properties linestring 48 52))
- (playerinfo))
- (add-to-list 'playerinfo rankstring)
- (add-to-list 'playerinfo namestring t)
- (add-to-list 'playerinfo elostring t)
- (add-to-list 'playerinfo 0 t)
- ;;(add-to-list 'playerinfo (arbitools-get-player-opponents-average
(string-to-number rankstring)) t)
- (add-to-list 'arbitools-players-info playerinfo t)))))
+ (playerinfo
+ `(,rankstring
+ ,namestring
+ ,elostring
+ 0)))
+ ;;(add-to-list 'playerinfo (arbitools-get-player-opponents-average
(string-to-number rankstring)) t)
+ ;; FIXME: Why append it to the end (which requires traversing the whole
+ ;; list) rather than add it to the front (which is super-cheap)?
+ (add-to-list 'arbitools-players-info playerinfo t)))))
(defun arbitools-do-pairings (round)
"Use bbpPairings to do the pairings for the next round.
You need a XXR section followed by the number of rounds.
- If you have any players that are not going to be paired,
- insert 0000 - H in the column, for a half point bye and
+ If you have any players that are not going to be paired,
+ insert 0000 - H in the column, for a half point bye and
0000 - F for full point bye. You can do that with
arbitools-insert-bye. For the first round you will need a
XXC section followed by white1 or black1, which will force
the corresponding colour.
- If the program throws an error you will find it in the
+ If the program throws an error you will find it in the
Pairings-output buffer."
;; TODO: if there is no XXR entry, error and prompt to write one.
;; TODO: right now, the program writes "0" as an opponent for allocated bye:
;; replace this with "0000 - U".
(interactive "sWhich round do you need to generate the pairings for?: ")
- (save-excursion
- (with-current-buffer "Pairings-output"
- (erase-buffer)))
+ (with-current-buffer "Pairings-output"
+ (erase-buffer))
(call-process "bbpPairings.exe" nil "Pairings-output" nil "--dutch"
buffer-file-name "-p")
-
- (let* ((actualround (arbitools-actual-round))
- (numberofrounds (arbitools-number-of-rounds))
+
+ (let* (;; (actualround (arbitools-actual-round))
+ ;; (numberofrounds (arbitools-number-of-rounds))
(numberoftables 0)
(actualtable 0)
(white 0)
(black 0)
(positiontowrite (+ 89 (* (- (string-to-number round) 1) 10)))
(endoflinecolumn 0))
-
- (save-excursion
- (with-current-buffer "Pairings-output"
- (goto-char (point-min))
- (setq numberoftables (string-to-number (thing-at-point 'word)))))
- (while (<= actualtable numberoftables)
- (save-excursion
- (with-current-buffer "Pairings-output"
- (forward-line)
- (setq actualtable (+ actualtable 1))
- (setq white (thing-at-point 'word))
- (forward-word)
- (forward-word)
- (setq black (thing-at-point 'word))))
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^001" nil t)
- (forward-char 4) ;; go to rank number
- (when (string= white (thing-at-point 'word))
- (end-of-line)
- (setq endoflinecolumn (current-column))
- (beginning-of-line)
- (forward-char positiontowrite)
- (unless (= positiontowrite endoflinecolumn) ;; check if there
is something and
- (delete-char (- endoflinecolumn positiontowrite))) ;; erase
it
- (insert " ") ;; replace the first positions with spaces
- (cond ((= 2 (length black)) (backward-char 1));; make room for
bigger numbers
- ((= 3 (length black)) (backward-char 2)))
- (insert (format "%s w " black))
- (cond ((= 2 (length black)) (delete-char 1));; adjust when
numbers are longer
- ((= 3 (length black)) (delete-char 2))))
- (when (string= black (thing-at-point 'word))
- (end-of-line)
- (setq endoflinecolumn (current-column))
- (beginning-of-line)
- (forward-char positiontowrite)
- (unless (= positiontowrite endoflinecolumn) ;; check if there
is something and
- (delete-char (- endoflinecolumn positiontowrite))) ;; erase
it
- (insert " ") ;; replace the first positions with spaces
- (cond ((= 2 (length white)) (backward-char 1)) ;; make room for
bigger numbers
- ((= 3 (length white)) (backward-char 2)))
- (insert (format "%s b " white))
- (cond ((= 2 (length white)) (delete-char 1));; adjust when
numbers are longer
- ((= 3 (length white)) (delete-char 2)))))))))
+
+ (with-current-buffer "Pairings-output"
+ (goto-char (point-min))
+ (setq numberoftables (string-to-number (thing-at-point 'word))))
+ (while (<= actualtable numberoftables)
+ (with-current-buffer "Pairings-output"
+ (forward-line)
+ (setq actualtable (+ actualtable 1))
+ (setq white (thing-at-point 'word))
+ (forward-word)
+ (forward-word)
+ (setq black (thing-at-point 'word)))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^001" nil t)
+ (forward-char 4) ;; go to rank number
+ (when (string= white (thing-at-point 'word))
+ (end-of-line)
+ (setq endoflinecolumn (current-column))
+ (beginning-of-line)
+ (forward-char positiontowrite)
+ (unless (= positiontowrite endoflinecolumn) ;; check if there is
something and
+ (delete-char (- endoflinecolumn positiontowrite))) ;; erase it
+ (insert " ") ;; replace the first positions with spaces
+ (cond ((= 2 (length black)) (backward-char 1)) ;; make room for
bigger numbers
+ ((= 3 (length black)) (backward-char 2)))
+ (insert (format "%s w " black))
+ (cond ((= 2 (length black)) (delete-char 1)) ;; adjust when
numbers are longer
+ ((= 3 (length black)) (delete-char 2))))
+ (when (string= black (thing-at-point 'word))
+ (end-of-line)
+ (setq endoflinecolumn (current-column))
+ (beginning-of-line)
+ (forward-char positiontowrite)
+ (unless (= positiontowrite endoflinecolumn) ;; check if there is
something and
+ (delete-char (- endoflinecolumn positiontowrite))) ;; erase it
+ (insert " ") ;; replace the first positions with spaces
+ (cond ((= 2 (length white)) (backward-char 1)) ;; make room for
bigger numbers
+ ((= 3 (length white)) (backward-char 2)))
+ (insert (format "%s b " white))
+ (cond ((= 2 (length white)) (delete-char 1)) ;; adjust when
numbers are longer
+ ((= 3 (length white)) (delete-char 2)))))))))
(defun arbitools-prepare-file-DOS ()
"Prepare file for DOS: add carriage return at the end of lines.
For some administrators, like the ones in FEDA, the files need
to be in this format or they will not allow them."
(interactive)
+ ;; FIXME: Most likely this should be replaced by something like
+ ;; (set-buffer-file-coding-system 'dos)
(save-excursion
(goto-char (point-min))
(while (search-forward "\n" nil t)
@@ -242,8 +246,8 @@
s))
(defun arbitools-arpo-vega ()
- "Create userTB.txt file for file generated with ARPO app.
- Use in crosstable.txt generated in Vega.
+ "Create userTB.txt file for file generated with ARPO app.
+ Use in crosstable.txt generated in Vega.
You need to open the ARPO1.txt file in another buffer."
(interactive)
(save-excursion
@@ -256,7 +260,8 @@
namesplit)
(when (not (get-buffer "userTB.txt")) (generate-new-buffer "userTB.txt"))
- (save-excursion (with-current-buffer "userTB.txt" (erase-buffer) (insert
" User Tie-Break ;")))
+ (with-current-buffer "userTB.txt"
+ (erase-buffer) (insert " User Tie-Break ;"))
(while continue ;; loop over crosstable.txt
(beginning-of-line) (forward-word)
(if (thing-at-point 'word)
@@ -267,26 +272,26 @@
(setq namesplit (split-string name ",")) ;; remove the comma,
which is not in ARPO1
(setq name (mapconcat 'identity namesplit "" )) ;; remove the
comma
(setq name (arbitools-trim-right name)) ;; remove the comma
-
- (save-excursion (with-current-buffer "ARPO1.txt"
- (goto-char (point-min))
-
- (if (search-forward name) ;; find the name from crosstable
+
+ (with-current-buffer "ARPO1.txt"
+ (goto-char (point-min))
+
+ (if (search-forward name) ;; find the name from crosstable
;; then
(progn
(end-of-line)(backward-word) ;; go to the end of line,
where the ARPO is
(setq arpopoint (thing-at-point 'word))(backward-word) ;;
get decimal figures
(setq arpodata (thing-at-point 'word)) ;;get integer part
-
- (save-excursion (with-current-buffer "userTB.txt"
+
+ (with-current-buffer "userTB.txt"
(insert arpodata)(insert ".")
- (insert arpopoint) (insert ";")))) ;; insert the ARPO
in userTB.txt
- ;; else
- (save-excursion (with-current-buffer "userTB.txt"
- (insert "0.0;")))))) ;; in case the player has not got
an ARPO, write a 0
- (forward-line))
- ;;else statement
- (setq continue nil)))))) ;; if no more players, tell the while to
stop
+ (insert arpopoint) (insert ";"))) ;; insert the ARPO in
userTB.txt
+ ;; else
+ (with-current-buffer "userTB.txt"
+ (insert "0.0;")))) ;; in case the player has not got an
ARPO, write a 0
+ (forward-line))
+ ;;else statement
+ (setq continue nil)))))) ;; if no more players, tell the while to stop
(defun arbitools-list-pairing (round)
@@ -308,27 +313,25 @@
(saveposition)
(savepositionstandings)
(namestring nil)
- (playerlinestring nil)
- (opponentlinestring "- ")
(opponentstring nil)
(rankstring nil)
(fideidstring nil)
(opponent nil)
(color nil)
(result nil))
-
+
(goto-char (point-min))
(re-search-forward "^012" nil t)
(setq tournamentnamestring (substring-no-properties (thing-at-point
'line) 4 (end-of-line)))
(goto-char (point-min))
(re-search-forward "^062" nil t)
- (setq numberofplayers (string-to-number (substring-no-properties
+ (setq numberofplayers (string-to-number (substring-no-properties
(thing-at-point 'line) 4 (end-of-line))))
(with-current-buffer "Pairings List"
(erase-buffer)
(insert (format "%s" tournamentnamestring))
(insert (format "Pairings for round %s\n\n" round)))
- (with-current-buffer "Standings"
+ (with-current-buffer "Standings"
(goto-char (point-min)) (forward-line 4) (setq savepositionstandings
(point)))
(while (>= numberofplayers 1)
(with-current-buffer "Standings"
@@ -340,13 +343,13 @@
(search-forward fideidstring)
(setq rankstring (arbitools-trim-left (substring-no-properties
(thing-at-point 'line) 4 8)))
(setq namestring (substring-no-properties (thing-at-point 'line) 14
46))
- (setq opponent (arbitools-trim-left (substring-no-properties
(thing-at-point 'line)
+ (setq opponent (arbitools-trim-left (substring-no-properties
(thing-at-point 'line)
(+ 91 (* (- (string-to-number round) 1)10 ))
(+ 95(* (- (string-to-number round) 1) 10 )))))
- (setq color (substring-no-properties (thing-at-point 'line)
+ (setq color (substring-no-properties (thing-at-point 'line)
(+ 96 (* (- (string-to-number round) 1)10 ))
(+ 97(* (- (string-to-number round) 1) 10 ))))
- (setq result (substring-no-properties (thing-at-point 'line)
+ (setq result (substring-no-properties (thing-at-point 'line)
(+ 98 (* (- (string-to-number round) 1)10 ))
(+ 99(* (- (string-to-number round) 1) 10 ))))
@@ -357,61 +360,61 @@
(when (string= (arbitools-trim-left opponent) (thing-at-point
'word))
(setq opponentstring (substring-no-properties (thing-at-point
'line) 14 46))
(with-current-buffer "Arbitools-output" (insert (format "%s"
opponentstring)))))
- (goto-char saveposition)
+ (goto-char saveposition)
(unless (or (member rankstring paired) (member opponent paired))
- (cl-pushnew rankstring paired :test #'equal)
+ (cl-pushnew rankstring paired :test #'equal)
(with-current-buffer "Pairings List"
(setq tablenumberstring (number-to-string tablenumber))
- (when (< (length tablenumberstring) 2)
+ (when (< (length tablenumberstring) 2)
(setq tablenumberstring (concat " " tablenumberstring)))
- (when (< (length rankstring) 2)
+ (when (< (length rankstring) 2)
(setq rankstring (concat rankstring " ")))
- (when (< (length opponent) 2)
+ (when (< (length opponent) 2)
(setq opponent (concat opponent " ")))
(cond ((string= color "w")
(cond ((string= result "1")
- (insert (format "%s. %s %s 1-0 %s %s\n"
tablenumberstring rankstring
+ (insert (format "%s. %s %s 1-0 %s %s\n"
tablenumberstring rankstring
namestring opponent opponentstring)))
((string= result "0")
- (insert (format "%s. %s %s 0-1 %s %s\n"
tablenumberstring rankstring
+ (insert (format "%s. %s %s 0-1 %s %s\n"
tablenumberstring rankstring
namestring opponent opponentstring)))
((string= result "+")
- (insert (format "%s. %s %s + - %s %s\n"
tablenumberstring rankstring
+ (insert (format "%s. %s %s + - %s %s\n"
tablenumberstring rankstring
namestring opponent opponentstring)))
((string= result "-")
- (insert (format "%s. %s %s - + %s %s\n"
tablenumberstring rankstring
+ (insert (format "%s. %s %s - + %s %s\n"
tablenumberstring rankstring
namestring opponent opponentstring)))
((string= result " ")
- (insert (format "%s. %s %s - %s %s\n"
tablenumberstring rankstring
+ (insert (format "%s. %s %s - %s %s\n"
tablenumberstring rankstring
namestring opponent opponentstring)))
((string= result "=")
- (insert (format "%s. %s %s 1/2 %s %s\n"
tablenumberstring rankstring
+ (insert (format "%s. %s %s 1/2 %s %s\n"
tablenumberstring rankstring
namestring opponent opponentstring)))))
((string= color "b")
(cond ((string= result "1")
- (insert (format "%s. %s %s 0-1 %s %s\n"
tablenumberstring opponent opponentstring
+ (insert (format "%s. %s %s 0-1 %s %s\n"
tablenumberstring opponent opponentstring
rankstring namestring)))
((string= result "0")
- (insert (format "%s. %s %s 1-0 %s %s\n"
tablenumberstring opponent opponentstring
+ (insert (format "%s. %s %s 1-0 %s %s\n"
tablenumberstring opponent opponentstring
rankstring namestring)))
((string= result "+")
- (insert (format "%s. %s %s - + %s %s\n"
tablenumberstring opponent opponentstring
+ (insert (format "%s. %s %s - + %s %s\n"
tablenumberstring opponent opponentstring
rankstring namestring)))
((string= result "-")
- (insert (format "%s. %s %s + - %s %s\n"
tablenumberstring opponent opponentstring
+ (insert (format "%s. %s %s + - %s %s\n"
tablenumberstring opponent opponentstring
rankstring namestring)))
((string= result " ")
- (insert (format "%s. %s %s - %s %s\n"
tablenumberstring opponent opponentstring
+ (insert (format "%s. %s %s - %s %s\n"
tablenumberstring opponent opponentstring
rankstring namestring)))
((string= result "=")
- (insert (format "%s. %s %s 1/2 %s %s\n"
tablenumberstring opponent opponentstring
+ (insert (format "%s. %s %s 1/2 %s %s\n"
tablenumberstring opponent opponentstring
rankstring namestring))))))))
(setq tablenumber (+ tablenumber 1))
(setq numberofplayers (- numberofplayers 1)))))
(switch-to-buffer "Pairings List"))
(defun arbitools-list-players ()
- "Put the list of players in two buffers, one in plain text and another
+ "Put the list of players in two buffers, one in plain text and another
in a beautiful LaTeX.
You will also find a list in the List of players buffer."
;; TODO: the beautiful LaTeX
@@ -422,19 +425,19 @@
(while (re-search-forward "^001" nil t)
(let* ((linestring (thing-at-point 'line))
(rankstring (substring linestring 5 8)))
-
+
(with-current-buffer "List of players"
(insert (format " %s " rankstring))))
(let* ((linestring (thing-at-point 'line))
(namestring (substring linestring 14 47)))
-
+
(with-current-buffer "List of players"
(insert (format "%s " namestring))))
(let* ((linestring (thing-at-point 'line))
(elostring (substring linestring 48 52)))
-
+
(with-current-buffer "List of players"
(insert (format "%s\n" elostring))))))
(with-current-buffer "List of players"
@@ -468,17 +471,17 @@
)
(defun arbitools-number-of-rounds ()
- "Get the number of rounds in the tournament. It has to be executed in the
+ "Get the number of rounds in the tournament. It has to be executed in the
principal buffer."
(let* ((numberofrounds 0))
-
+
(save-excursion
(if (re-search-forward "^XXR" nil t)
- (progn
+ (progn
(beginning-of-line)
(forward-char 5)
(setq numberofrounds (string-to-number (thing-at-point 'word))))
-
+
(goto-char (point-min))
(re-search-forward "^132" nil t)
(let* ((linestringrounds (thing-at-point 'line))
@@ -487,12 +490,12 @@
(continue t))
(while continue
(if (< end-of-round (length linestringrounds))
-
+
(progn
(setq numberofrounds (+ numberofrounds 1))
(setq beginning-of-round (+ beginning-of-round 10))
(setq end-of-round (+ end-of-round 10)))
-
+
(setq continue nil))))))
numberofrounds))
@@ -511,17 +514,17 @@
(setq actualround (/ (current-column) 10)))
(when (< actualround 0)
(setq actualround 0)))
- ;;(when arbitool-verbose (save-excursion (with-current-buffer
"Arbitools-output"
- ;; (insert (format "column: %d -" actualround)))))
+ ;;(when arbitool-verbose (with-current-buffer "Arbitools-output"
+ ;; (insert (format "column: %d -" actualround))))
actualround))
(defun arbitools-calculate-points (round)
- "Automatically calculate the points of each player and adjust the
- corresponding column.
+ "Automatically calculate the points of each player and adjust the
+ corresponding column.
Don't use this function when the round doesn't include all the results."
(interactive "sUp to which round?: ")
(save-excursion
- (let ( (numberofrounds (arbitools-number-of-rounds))
+ (let ( ;; (numberofrounds (arbitools-number-of-rounds))
(points 0.0)
(pointstosum 0.0)
(roundcount 1))
@@ -532,16 +535,19 @@
(while (<= roundcount (string-to-number round))
(beginning-of-line)
(forward-char (+ 98 (* (- roundcount 1) 10))) ;; go to where the
result is for each round
- (cond ((string= (thing-at-point 'symbol) "1") (setq pointstosum 1.0))
- ((string= (thing-at-point 'symbol) "+") (setq pointstosum 1.0))
- ((string= (thing-at-point 'symbol) "=") (setq pointstosum 0.5))
- ((string= (thing-at-point 'symbol) "0") (setq pointstosum 0.0))
- ((string= (thing-at-point 'symbol) "-") (setq pointstosum 0.0))
- ((string= (thing-at-point 'symbol) "F") (setq pointstosum 1.0))
- ((string= (thing-at-point 'symbol) "H") (setq pointstosum 0.5))
- ((string= (thing-at-point 'symbol) "Z") (setq pointstosum 0.0))
- ((string= (thing-at-point 'symbol) "U") (setq pointstosum 1.0))
- ((string= (thing-at-point 'symbol) nil) (setq pointstosum
0.0)))
+ (let ((sym (thing-at-point 'symbol)))
+ ;; FIXME: If `sym' doesn't match any of those, we keep the previous
+ ;; value of `pointstosum', which seems wrong.
+ (cond ((string= sym "1") (setq pointstosum 1.0))
+ ((string= sym "+") (setq pointstosum 1.0))
+ ((string= sym "=") (setq pointstosum 0.5))
+ ((string= sym "0") (setq pointstosum 0.0))
+ ((string= sym "-") (setq pointstosum 0.0))
+ ((string= sym "F") (setq pointstosum 1.0))
+ ((string= sym "H") (setq pointstosum 0.5))
+ ((string= sym "Z") (setq pointstosum 0.0))
+ ((string= sym "U") (setq pointstosum 1.0))
+ ((string= sym nil) (setq pointstosum 0.0))))
(setq points (+ points pointstosum))
(setq roundcount (+ roundcount 1)))
(beginning-of-line)
@@ -552,29 +558,28 @@
(insert (format "%s" points))))))
(defun arbitools-calculate-standings ()
- "Write the standings in the Standings buffer. Update the POS field in the
+ "Write the standings in the Standings buffer. Update the POS field in the
file.
You might need to run arbitools-calculate-points before using this
function."
- ;; TODO: Write tiebreaks. Write a new function that organize the standings
according
+ ;; TODO: Write tiebreaks. Write a new function that organize the standings
according
;; to a given tiebreak.
;; Also, make it possible to print standings for past rounds.
(interactive)
(save-excursion
- (save-excursion (with-current-buffer "Standings"
- (erase-buffer)))
+ (with-current-buffer "Standings"
+ (erase-buffer))
(arbitools-list-players)
- (let* ((linestring)
- (tournamentnamestring)
- (numberofplayers 0)
- (round "round")
- (datachunk "")
- (name)
- (arpo)
- (newpos 0)
- (idfide "")
- (beg)
- (end))
+ (let* ((tournamentnamestring)
+ (numberofplayers 0)
+ (round "round")
+ (datachunk "")
+ (name)
+ (arpo)
+ (newpos 0)
+ ;; (idfide "")
+ (beg)
+ (end))
(goto-char (point-min))
(re-search-forward "^062" nil t)
(forward-char 1)
@@ -582,11 +587,11 @@
(goto-char (point-min))
(re-search-forward "^012" nil t) ;; Get the name of the tournament
(setq tournamentnamestring (thing-at-point 'line))
- (save-excursion (with-current-buffer "Standings" ;; write the headings
- (erase-buffer)
+ (with-current-buffer "Standings" ;; write the headings
+ (erase-buffer)
(insert (format "%s" tournamentnamestring))
(insert (format "Standings for round %s\n\n" round))
- (insert (format "POS. PTS. No. Name ID
ARPO\n"))))
+ (insert (format "POS. PTS. No. Name ID
ARPO\n")))
(goto-char (point-min))
(while (re-search-forward "^001" nil t) ;; loop the players in the main
buffer
(beginning-of-line)
@@ -608,24 +613,24 @@
(insert " "))
(beginning-of-line)
(forward-char 67)
- (setq datachunk (thing-at-point 'word)) ;; get idfide
+ (setq datachunk (thing-at-point 'word)) ;; get idfide
(with-current-buffer "Standings"
(insert (format "%s" datachunk))
(insert-char ?\s (- 10 (length datachunk)))
(insert " "))
- (save-excursion (with-current-buffer "ARPO"
+ (with-current-buffer "ARPO"
(goto-char (point-min))
(re-search-forward name nil t)
(forward-word)
(setq arpo (thing-at-point 'word))
(forward-word)
- (setq arpo (format "%s.%s" arpo (thing-at-point 'word)))))
+ (setq arpo (format "%s.%s" arpo (thing-at-point 'word))))
(with-current-buffer "Standings"
;;(insert "2350.01234")
(insert (format "%s" arpo)) ;; fix tabs for sorting to work fine
(insert "\n"))
- )
- (save-excursion (with-current-buffer "Standings" ;; sorting
+ )
+ (with-current-buffer "Standings" ;; sorting
(goto-char (point-min))
(forward-line 4)
(setq beg (point))
@@ -646,15 +651,15 @@
(setq beg (point))
(goto-char (point-max))
(setq end (point))
- (reverse-region beg end))) ;; get this to sort in reverse
+ (reverse-region beg end)) ;; get this to sort in reverse
(goto-char (point-min))
(while (re-search-forward "^001" nil t)
(setq datachunk (substring-no-properties (thing-at-point 'line) 14 47))
- (save-excursion (with-current-buffer "Standings"
+ (with-current-buffer "Standings"
(goto-char (point-min))
(search-forward datachunk nil t)
- (setq newpos (- (line-number-at-pos) 4)))) ;; the number of gives as
the pos field
- ;; minus 4 because of the first
two lines
+ (setq newpos (- (line-number-at-pos) 4))) ;; the number of gives as
the pos field
+ ;; minus 4 because of the first two lines
(beginning-of-line)
(forward-char 89) ;; go to POS field
(forward-char -3)
@@ -667,7 +672,7 @@
(interactive "sInsert rank number of the player: ")
(let ((numberofrounds 0)
(elo ""))
-
+
(save-excursion
(goto-char (point-min))
(re-search-forward "^132" nil t)
@@ -682,7 +687,7 @@
;; (setq actualround (substring-no-properties
linestringrounds beginning-of-round end-of-round))
(setq numberofrounds (+ numberofrounds 1))
(setq beginning-of-round (+ beginning-of-round 10))
- (setq end-of-round (+ end-of-round 10)))
+ (setq end-of-round (+ end-of-round 10)))
(setq continue nil)))))
(save-excursion
(goto-char (point-min))
@@ -714,7 +719,7 @@
(insert (format "%s" (- (string-to-number rankstring)
1))))
(setq roundcount (+ roundcount 1))))
;;(condition-case nil ;; TODO: fix teams info
- (save-excursion
+ (save-excursion
(while (re-search-forward "^013" nil t)
(let* ((linestringteam (thing-at-point 'line))
(integrantcount 0)
@@ -732,7 +737,7 @@
(insert-char ?\s (- 4 (length (format "%s" (-
(string-to-number rankstring) 1)))))
(insert (format "%s" (- (string-to-number rankstring)
1))))
(setq integrantcount (+ integrantcount 1))))))))))))
-
+
(save-excursion ;; Actually delete the player's line
(goto-char (point-min))
(while (re-search-forward "^001 DEL" nil t)
@@ -747,14 +752,14 @@
(goto-char (point-min))
(re-search-forward "^062 ")
(let* ((linestring (thing-at-point 'line))
- (numberofplayers (substring linestring 4)))
+ (numberofplayers (substring linestring 4)))
(delete-char (length numberofplayers))
(setq numberofplayers (string-to-number numberofplayers))
(setq numberofplayers (- numberofplayers 1))
(insert (concat (number-to-string numberofplayers) "\n")))
(re-search-forward "^072 ")
(let* ((linestring (thing-at-point 'line))
- (numberofratedplayers (substring linestring 4)))
+ (numberofratedplayers (substring linestring 4)))
(unless (< (length elo) 2) ;; if elo is 0 or nonexistent
(delete-char (length numberofratedplayers))
(setq numberofratedplayers (string-to-number numberofratedplayers))
@@ -763,7 +768,7 @@
(defun arbitools-delete-round (round)
"Delete a round."
- ;; TODO: It seems that it doesn't delete a previous bye inserted.
+ ;; TODO: It seems that it doesn't delete a previous bye inserted.
(interactive "sround: ")
(save-excursion
(goto-char (point-min))
@@ -803,7 +808,7 @@
(insert-char ?\s (- 3 (length (format "%s" points)))) ;; write extra
empty spaces
(insert (format "%s" points)) ;; write the points
(beginning-of-line)
- (forward-char pointtowrite)
+ (forward-char pointtowrite)
(insert (format " 0000 - %s" type)))))))
(defun arbitools-replace-empty ()
@@ -819,11 +824,11 @@
;; TODO: automatically insert the player in a team
(interactive "ssex: \nstitle: \nsname: \nselo: \nsfed: \nsidfide: \nsyear:
")
(let ((playerlinelength nil)
- (thislinelength nil))
+ (thislinelength nil))
(save-excursion
(goto-char (point-min))
(re-search-forward "^001 ")
- (let* ((linestring (thing-at-point 'line)))
+ (let* ((linestring (thing-at-point 'line)))
(setq playerlinelength (length linestring))))
(save-excursion
(goto-char (point-min))
@@ -856,19 +861,19 @@
(insert-char ?\s (- 4 (length (format "%s" (+ (string-to-number
rankstring) 1)))))
(insert (format "%s" (+ (string-to-number rankstring) 1)))
(setq thislinelength (length (thing-at-point 'line)))
- (insert-char ?\s (- playerlinelength thislinelength)))))
+ (insert-char ?\s (- playerlinelength thislinelength)))))
(save-excursion
(goto-char (point-min))
(re-search-forward "^062 ")
(let* ((linestring (thing-at-point 'line))
- (numberofplayers (substring linestring 4)))
+ (numberofplayers (substring linestring 4)))
(delete-char (length numberofplayers))
(setq numberofplayers (string-to-number numberofplayers))
(setq numberofplayers (+ 1 numberofplayers))
(insert (concat (number-to-string numberofplayers) "\n")))
(re-search-forward "^072 ")
(let* ((linestring (thing-at-point 'line))
- (numberofratedplayers (substring linestring 4)))
+ (numberofratedplayers (substring linestring 4)))
(unless (< (length elo) 2)
(delete-char (length numberofratedplayers))
(setq numberofratedplayers (string-to-number numberofratedplayers))
@@ -892,7 +897,7 @@
(setq positionendofline (current-column))
(beginning-of-line)
(forward-char pointtowrite)
- (unless (= pointtowrite positionendofline) ;; check if there is
something and
+ (unless (= pointtowrite positionendofline) ;; check if there is
something and
(delete-char (- positionendofline pointtowrite))) ;; erase it
(insert " ") ;; replace the first positions with spaces
;; make room for bigger numbers
@@ -900,15 +905,16 @@
(backward-char 1))
((= 3 (length black))
(backward-char 2)))
- (insert (format "%s w %s" black result)))
+ (insert (format "%s w %s" black result)))
(when (string= black (thing-at-point 'word))
;; go to first round taking into account the cursor is in the rank
number
(end-of-line)
(setq positionendofline (current-column))
(beginning-of-line)
(forward-char pointtowrite)
- (unless (= pointtowrite positionendofline) ;; check if there is
something and
- (when arbitools-verbose (save-excursion (with-current-buffer
"Arbitools-output" (insert "yes"))))
+ (unless (= pointtowrite positionendofline) ;; check if there is
something and
+ (when arbitools-verbose
+ (with-current-buffer "Arbitools-output" (insert "yes")))
(delete-char (- positionendofline pointtowrite))) ;; erase it
(insert " ") ;; replace the first positions with spaces
;; make room for bigger numbers
@@ -947,96 +953,96 @@
(setq sum_mi_ci (+ sum_mi_ci (* (nth 3 (nth (- (string-to-number
opponent) 1) arbitools-players-info)) (length (arbitools-get-player-opponents
(string-to-number opponent))))))
)
(setq ci (- (nth 3 (nth (- player 1) arbitools-players-info)) (/
sum_mi_ci sum_mi)))
- (when arbitools-verbose (save-excursion (with-current-buffer
"Arbitools-output"
- (insert (format "Player %d sum_mi_ci %d sum_mi %d ci %d\n"
- player sum_mi_ci sum_mi ci)))))
+ (when arbitools-verbose
+ (with-current-buffer "Arbitools-output"
+ (insert (format "Player %d sum_mi_ci %d sum_mi %d ci %d\n"
+ player sum_mi_ci sum_mi ci))))
ci))
)
(defun arbitools-get-player-opponents (player)
- "Takes the player's rank as argument. Returns a list which contains the rank
number
+ "Takes the player's rank as argument. Returns a list which contains the rank
number
of player opponents in the tournament. Worst passes the number of worst
opponents
to remove from the list"
(save-excursion
(let*((opps nil)
(oppspoints nil)
- (opponent 000)
- (roundcount 1))
+ (opponent 000))
(goto-char (point-min))
- (let* ((maxlength 0)
- (numberofrounds)
+ (re-search-forward (format "^001[[:space:]]\\{1,4\\}%d" player))
+ (end-of-line)
+
+ (let* ((maxlength (current-column))
+ (numberofrounds (/ (- maxlength 89) 10))
(offset 0))
-
- (re-search-forward (format "^001[[:space:]]\\{1,4\\}%d" player))
- (end-of-line)
- (setq maxlength (+ maxlength (current-column)))
- (setq numberofrounds (/ (- maxlength 89) 10))
- (dotimes (number numberofrounds)
- (setq offset (+ 94 (* (- roundcount 1) 10)))
+
+ (dotimes (roundcount-1 numberofrounds)
+ (setq offset (+ 94 (* roundcount-1 10)))
(beginning-of-line)
(forward-char offset)
(setq opponent (thing-at-point 'word))
- (when (and (not (string= opponent " "))(not (string= opponent
""))(not (string= opponent nil))(not (string= opponent "0000")))
- (add-to-list 'opps opponent))
- (setq roundcount (+ roundcount 1))))
-
+ (when (not (member opponent '(" " "" nil "nil" "0000")))
+ (cl-pushnew opponent opps :test #'equal))))
+
;;do list opponents, create an alist with the points of each opponent
(dolist (opp opps)
- (let* ((points 0.0))
- (setq points (arbitools-get-player-played-points (string-to-number
opp)))
- (add-to-list 'oppspoints (cons opp points))))
+ (let* ((points (arbitools-get-player-played-points
+ (string-to-number opp))))
+ (cl-pushnew (cons opp points) oppspoints :test #'equal)))
- (setq oppspoints (sort oppspoints (lambda (a b) (< (cdr a) (cdr b)))))
;; sort does not work properly, erases elements
+ ;; Beware: `sort' "consumes" its argument, so it's indispensable to use
+ ;; its return value.
+ (setq oppspoints (sort oppspoints (lambda (a b) (< (cdr a) (cdr b)))))
(when (and (> (length opps) 4) arbitools-arpo-cutworst)
- (setq opps (delete (car (car oppspoints)) opps)))
;; cut worst opponent
+ (setq opps (delete (car (car oppspoints)) opps))) ;; cut worst opponent
(when (and (> (length opps) 4) arbitools-arpo-cutbest)
(setq opps (delete (car (nth (- (length oppspoints) 1) oppspoints))
opps))) ;; cut best opponent
- (when arbitools-verbose (save-excursion (with-current-buffer
"Arbitools-output"
- (insert (format "Player: %d opponents: %d: %s oppspoints %d: %s worst
%s best %s\n"
- player (length opps) opps (length oppspoints) oppspoints (car (car
oppspoints)) (car (nth (- (length oppspoints) 1) oppspoints)))))))
+ (when arbitools-verbose
+ (with-current-buffer "Arbitools-output"
+ (insert (format "Player: %d opponents: %d: %s oppspoints %d: %s worst
%s best %s\n"
+ player
+ (length opps) opps
+ (length oppspoints) oppspoints
+ (car (car oppspoints))
+ (car (nth (- (length oppspoints) 1) oppspoints))))))
opps)))
(defun arbitools-get-player-played-points (player)
- "Takes the player's rank as argument. Returns points got by player in actual
games"
- ;; TODO manage results such as 0000 - =
+ "Take the player's rank as argument. Return points got by player in actual
games"
+ ;; TODO manage results such as 0000 - =
(save-excursion
(let*((points 0.0)
- (result 0)
- (roundcount 1))
-
+ (result 0))
+
(goto-char (point-min))
- (let* ((linestring (thing-at-point 'line))
- (maxlength 0)
- (numberofrounds)
- (offset 0)
- (rankstring (substring-no-properties linestring 5 8))
- (rank (string-to-number rankstring)))
+ (let* (;; (linestring (thing-at-point 'line))
+ (maxlength 0)
+ (numberofrounds)
+ (offset 0)
+ ;; (rankstring (substring-no-properties linestring 5 8))
+ ;; (rank (string-to-number rankstring))
+ )
(re-search-forward (format "^001[[:space:]]\\{1,4\\}%d" player))
(end-of-line)
(setq maxlength (+ maxlength (current-column)))
(setq numberofrounds (/ (- maxlength 89) 10))
- (dotimes (number numberofrounds)
- (setq offset (+ 98 (* (- roundcount 1) 10)))
+ (dotimes (roundcount-1 numberofrounds)
+ (setq offset (+ 98 (* roundcount-1 10)))
(beginning-of-line)
(forward-char offset)
(setq result (thing-at-point 'symbol))
- (when (and (and (and (and (not (string= result nil))
- (not (string= result "-")))
- (not (string= result "F")))
- (not (string= result "H")))
- (not (string= result "Z")))
- (cond
- ((string= result "1")(setq points (+ 1 points)))
- ((string= result "+")(setq points (+ 1 points)))
- ((string= result "=")(setq points (+ 0.5 points)))))
- (setq roundcount (+ roundcount 1))))
+ (when (not (member result '(nil "nil" "-" "F" "H" "Z")))
+ (cond
+ ((string= result "1")(setq points (+ 1 points)))
+ ((string= result "+")(setq points (+ 1 points)))
+ ((string= result "=")(setq points (+ 0.5 points)))))))
points)))
(defun arbitools-get-player-performance (player)
- "Takes the player's rank as argument. Returns the performance of the player
+ "Take the player's rank as argument. Return the performance of the player
in the tournament"
;; TODO for some reason, get-player-opponents gets cutworst at always true
(save-excursion
@@ -1050,40 +1056,38 @@
(numberofopponents 0))
;; discard points against discarded opponents
(goto-char (point-min))
- (let* ((linestring (thing-at-point 'line))
- (maxlength 0)
- (numberofrounds)
- (roundcount 1)
- (opp 000)
- (offset 0))
-
+ (let* (;; (linestring (thing-at-point 'line))
+ (maxlength 0)
+ (numberofrounds)
+ (opp 000)
+ (offset 0))
+
(re-search-forward (format "^001[[:space:]]\\{1,4\\}%d" player))
(end-of-line)
(setq maxlength (+ maxlength (current-column)))
(setq numberofrounds (/ (- maxlength 89) 10))
- (dotimes (number numberofrounds)
- (setq offset (+ 94 (* (- roundcount 1) 10)))
- (beginning-of-line)
- (forward-char offset)
- (setq opp (thing-at-point 'word))
- (when (not (member opp opponents))
-
- (forward-char 4)
- (when (string= (thing-at-point 'symbol) "1")
- (setq discard (+ discard 1.0)))
- (when (string= (thing-at-point 'symbol) "+")
- (setq discard (+ discard 1.0)))
- (when (string= (thing-at-point 'symbol) "=")
- (setq discard (+ discard 0.5))))
- (setq roundcount (+ roundcount 1))))
-
+ (dotimes (roundcount-1 numberofrounds)
+ (setq offset (+ 94 (* roundcount-1 10)))
+ (beginning-of-line)
+ (forward-char offset)
+ (setq opp (thing-at-point 'word))
+ (when (not (member opp opponents))
+
+ (forward-char 4)
+ (when (string= (thing-at-point 'symbol) "1")
+ (setq discard (+ discard 1.0)))
+ (when (string= (thing-at-point 'symbol) "+")
+ (setq discard (+ discard 1.0)))
+ (when (string= (thing-at-point 'symbol) "=")
+ (setq discard (+ discard 0.5))))))
+
;; loop over opponents and get their elo average
(dolist (opponent opponents)
(let* ((rating (string-to-number (nth 2
- (nth (- (string-to-number opponent) 1) arbitools-players-info)))))
+ (nth (- (string-to-number
opponent) 1) arbitools-players-info)))))
(when (not rating) (setq rating arbitools-elo-floor))
- (when (not (numberp rating)) (setq rating arbitools-elo-floor)) ;;
floor rating here
- (when (= rating 0) (setq rating arbitools-elo-floor)) ;;
floor rating here
+ (when (not (numberp rating)) (setq rating arbitools-elo-floor)) ;;
floor rating here
+ (when (= rating 0) (setq rating arbitools-elo-floor)) ;; floor rating
here
(setq eloaverage (+ eloaverage rating))
(setq numberofopponents (+ numberofopponents 1))))
;; calculate performance
@@ -1092,12 +1096,12 @@
(setq percentage (/ points numberofopponents))
(setq diff (nth (truncate (* 100 percentage))
arbitools-performancetable))
(setf (nth 3 (nth (- player 1) arbitools-players-info)) diff)
- (when (and diff arbitools-verbose) (save-excursion (with-current-buffer
"Arbitools-output" (insert (format "Correct! player %d eloaverage: %d points:%f
numberofopponents:%d percentage: %d\n" player eloaverage points
numberofopponents (* percentage 100))))))
- (when (and diff arbitools-verbose) (save-excursion (with-current-buffer
"Arbitools-output" (insert (format "Players's info player %s diff %d\n" (nth 1
(nth (- player 1) arbitools-players-info)) diff)))))
+ (when (and diff arbitools-verbose) (with-current-buffer
"Arbitools-output" (insert (format "Correct! player %d eloaverage: %d points:%f
numberofopponents:%d percentage: %d\n" player eloaverage points
numberofopponents (* percentage 100)))))
+ (when (and diff arbitools-verbose) (with-current-buffer
"Arbitools-output" (insert (format "Players's info player %s diff %d\n" (nth 1
(nth (- player 1) arbitools-players-info)) diff))))
(when (not diff) (setq diff 0)
- (save-excursion (with-current-buffer "Arbitools-output" (insert
(format "Warning! player %d diff=0 eloaverage: %d points:%d
numberofopponents:%d percentage: %d\n" player eloaverage points
numberofopponents (* 100 percentage))))))
+ (with-current-buffer "Arbitools-output" (insert (format "Warning!
player %d diff=0 eloaverage: %d points:%d numberofopponents:%d percentage:
%d\n" player eloaverage points numberofopponents (* 100 percentage)))))
(setq performance (+ eloaverage diff))
- performance)))
+ performance)))
@@ -1105,30 +1109,33 @@
"Calculates the performance for all the players in the tourmanent and writes
them in a buffer,
ordered by player rank."
(save-excursion
- (let*((performance 0.0)
- (performances))
-
- (when arbitools-verbose (save-excursion (with-current-buffer "Players
performance"
- (delete-region (point-min)(point-max))
- (insert "rank Name
Performance\n"))))
- ;; Loop over players and calculate performances
- (dotimes (iter (length arbitools-players-info))
- (let* ((rating (string-to-number (nth 2 (nth iter
arbitools-players-info))))
- (name (nth 1 (nth iter arbitools-players-info))))
-
- (setq performance (arbitools-get-player-performance (+ iter 1)))
+ (let* ((performance 0.0)
+ (performances))
+
+ (when arbitools-verbose
+ (with-current-buffer "Players performance"
+ (delete-region (point-min)(point-max))
+ (insert "rank Name Performance\n")))
+ ;; Loop over players and calculate performances
+ (dotimes (iter (length arbitools-players-info))
+ (let* (;; (rating (string-to-number
+ ;; (nth 2 (nth iter arbitools-players-info))))
+ (name (nth 1 (nth iter arbitools-players-info))))
+
+ (setq performance (arbitools-get-player-performance (+ iter 1)))
(push performance performances)
- (when arbitools-verbose (save-excursion (with-current-buffer "Players
performance"
- (goto-char (point-max))
- (insert (format "%d %s %s\n" (+ iter 1) name performance)))))))
- performances)))
+ (when arbitools-verbose
+ (with-current-buffer "Players performance"
+ (goto-char (point-max))
+ (insert (format "%d %s %s\n" (+ iter 1) name performance))))))
+ performances)))
(defun arbitools-calculate-arpo ()
- "Calculates the ARPO for all the players and writes the results to a buffer.
+ "Calculates the ARPO for all the players and writes the results to a buffer.
also it creates a userTB.txt buffer, so that it can be used in Vega."
;; TODO This algorythm is terribly inefficient, it should be improved
(interactive)
-
+
;;(arbitools-fill-players-info)
(save-excursion
(let* ((iterand )
@@ -1149,20 +1156,18 @@
(difference)
(continue t)
numberofplayers
- numberofopponents
- lengthopponents
- sum_mi
- sum_mi_ci)
-
+ numberofopponents)
+
(setq iterand_1 performances) ;; store performance list
in iterand_1 for the first iteration
(setq numberofplayers (length performances))
(while continue ;; iterate performances
until the check is true
(setq iterand iterand_1) ;; fill iterand with
iterand_1
(setq iterand_1 nil) ;; reset iterand_1
(setq sumiterand (apply '+ iterand)) ;; sum
elements in iterand
- (when arbitools-verbose (save-excursion (with-current-buffer
"Arbitools-output"
- (insert (format "Starting run %d; iterand: %s sum_iterand:
%d\n"
- iterations iterand sumiterand)))))
+ (when arbitools-verbose
+ (with-current-buffer "Arbitools-output"
+ (insert (format "Starting run %d; iterand: %s sum_iterand: %d\n"
+ iterations iterand sumiterand))))
(dotimes (number numberofplayers) ;; loop the list of
performances
(setq opponents (arbitools-get-player-opponents (+ number 1)))
(setq numberofopponents (length opponents))
@@ -1185,7 +1190,6 @@
(goto-char (point-min))
(let* ((maxlength 0)
(numberofrounds)
- (roundcount 1)
(opp 000)
(offset 0))
@@ -1193,43 +1197,44 @@
(end-of-line)
(setq maxlength (+ maxlength (current-column)))
(setq numberofrounds (/ (- maxlength 89) 10))
- (dotimes (number_1 numberofrounds)
- (setq offset (+ 94 (* (- roundcount 1) 10)))
- (beginning-of-line)
- (forward-char offset)
- (setq opp (thing-at-point 'word))
- (when (not (member opp opponents))
- (forward-char 4)
- (when (string= (thing-at-point 'symbol) "1")(setq discard
(+ discard 1.0)))
- (when (string= (thing-at-point 'symbol) "+")(setq discard
(+ discard 1.0)))
- (when (string= (thing-at-point 'symbol) "F")(setq discard
(+ discard 1.0)))
- (when (string= (thing-at-point 'symbol) "H")(setq discard
(+ discard 0.5)))
- (when (string= (thing-at-point 'symbol) "=")(setq discard
(+ discard 0.5))))
- (setq roundcount (+ roundcount 1))))
-
+ (dotimes (roundcount-1 numberofrounds)
+ (setq offset (+ 94 (* roundcount-1 10)))
+ (beginning-of-line)
+ (forward-char offset)
+ (setq opp (thing-at-point 'word))
+ (when (not (member opp opponents))
+ (forward-char 4)
+ (cond
+ ((member (thing-at-point 'symbol) '("1" "+" "F"))
+ (setq discard (+ discard 1.0)))
+ ((member (thing-at-point 'symbol) '("H" "="))
+ (setq discard (+ discard 0.5)))))))
+
;; calculate percentage of points
(setq points (arbitools-get-player-played-points (+ number 1)))
(setq points (- points discard))
(when (> (length opponents) 0) (setq percentage (/ points
numberofopponents)))
(setq diff (arbitools-get-player-ci (+ number 1)))
(setq averageperformanceofopponents (+
averageperformanceofopponents diff))
- (when arbitools-verbose (save-excursion (with-current-buffer
"Arbitools-output"
- (insert (format " c %d----\n" diff)))))
+ (when arbitools-verbose
+ (with-current-buffer "Arbitools-output"
+ (insert (format " c %d----\n" diff))))
+
+ (when arbitools-verbose
+ (with-current-buffer "Arbitools-output"
+ (insert (format "Success! player %d run %d points %f discard %f
opponents %d: %s percentage %f ARPO averageperformanceofopponents %f
performances %s diff %d\n"
+ (+ number 1) iterations points discard
numberofopponents opponents percentage averageperformanceofopponents
performancesopponents diff))))
- (when arbitools-verbose (save-excursion (with-current-buffer
"Arbitools-output"
- (insert (format "Success! player %d run %d points %f discard
%f opponents %d: %s percentage %f ARPO averageperformanceofopponents %f
performances %s diff %d\n"
- (+ number 1) iterations points discard numberofopponents
opponents percentage averageperformanceofopponents performancesopponents
diff)))))
-
(push averageperformanceofopponents iterand_1))
-
+
(setq iterand_1 (reverse iterand_1)) ;; reverse iterand_1
(setq differences nil)
-
+
;; write difference in a list to check for convergence
(dotimes (number numberofplayers)
(setq difference (- (nth number iterand) (nth number iterand_1)))
(push difference differences))
-
+
;; check if the model converges
(when (and (< (abs (- (nth 1 differences) (nth 0 differences)))
0.0000000001) ;; define here the value of epsilon
(< (abs (- (nth (- numberofplayers 1) differences) (nth 0
differences))) 0.0000000001))
@@ -1237,29 +1242,33 @@
(setq iterations (+ iterations 1))
(when (or converges (= iterations 300)) (setq continue nil))) ;;
define here maximum number of iterations
-
+
;; write a buffer with rank, name and the value from the last list
obtained
- (when arbitools-verbose (save-excursion (with-current-buffer
"Arbitools-output"
- (insert (format "difference: %f differences: %s converges: %s"
- (- (nth 1 differences) (nth 0 differences))
- differences converges)))))
+ (when arbitools-verbose
+ (with-current-buffer "Arbitools-output"
+ (insert (format "difference: %f differences: %s converges: %s"
+ (- (nth 1 differences) (nth 0 differences))
+ differences converges))))
;; write the results in the corresponding buffer
- (save-excursion (with-current-buffer "ARPO"
- (goto-char (point-min))
- (delete-region (point-min)(point-max))
- (insert "rank Name
ARPO\n")))
- (save-excursion (with-current-buffer "UserTB.txt"
- (goto-char (point-min))
- (delete-region (point-min)(point-max))
- (insert " User Tie-Break ;")))
+ (with-current-buffer "ARPO"
+ (goto-char (point-min))
+ (delete-region (point-min)(point-max))
+ (insert "rank Name ARPO\n"))
+ (with-current-buffer "UserTB.txt"
+ (goto-char (point-min))
+ (delete-region (point-min)(point-max))
+ (insert " User Tie-Break ;"))
(dotimes (iter (length iterand_1))
- (let* ((rating (string-to-number (nth 2 (nth iter
arbitools-players-info))))
- (name (nth 1 (nth iter arbitools-players-info)))
- (arpo (nth iter iterand_1)))
- (save-excursion (with-current-buffer "ARPO" (insert (format "%d
%s %s\n" (+ iter 1) name arpo))))
- (save-excursion (with-current-buffer "UserTB.txt" (insert (format
"%s;" arpo)))))))))
+ (let* (;; (rating (string-to-number
+ ;; (nth 2 (nth iter arbitools-players-info))))
+ (name (nth 1 (nth iter arbitools-players-info)))
+ (arpo (nth iter iterand_1)))
+ (with-current-buffer "ARPO"
+ (insert (format "%d %s %s\n" (+ iter 1) name arpo)))
+ (with-current-buffer "UserTB.txt"
+ (insert (format "%s;" arpo))))))))
(defun arbitools-it3 ()
"Get the IT3 tournament report. You will get a .tex file, and a pdf
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] master f8771e9: * packages/arbitools/arbitools.el: Various code tweaks,
Stefan Monnier <=