The Lambda Lab
/
projects
/
jars.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
d7a887f
)
Cleaning up ranking system.
author
plugd
<plugd@thelambdalab.xyz>
Fri, 8 May 2020 17:21:54 +0000
(19:21 +0200)
committer
plugd
<plugd@thelambdalab.xyz>
Fri, 8 May 2020 17:21:54 +0000
(19:21 +0200)
koth.scm
patch
|
blob
|
history
diff --git
a/koth.scm
b/koth.scm
index
61852c5
..
3ad5925
100644
(file)
--- a/
koth.scm
+++ b/
koth.scm
@@
-73,8
+73,8
@@
(< (cadr a) (cadr b))))))
(define (challenge hill-dir challenger-file)
(< (cadr a) (cadr b))))))
(define (challenge hill-dir challenger-file)
- (let* ((spec (
load
-spec hill-dir))
- (scores (
load
-scores hill-dir))
+ (let* ((spec (
hill
-spec hill-dir))
+ (scores (
hill
-scores hill-dir))
(challenger-prog (file->prog challenger-file))
(hill-progs (map file->prog (hill-files hill-dir))))
(if (member (prog-name challenger-prog) (map prog-name hill-progs))
(challenger-prog (file->prog challenger-file))
(hill-progs (map file->prog (hill-files hill-dir))))
(if (member (prog-name challenger-prog) (map prog-name hill-progs))
@@
-84,39
+84,45
@@
(rankings (scores->rankings new-scores)))
(if (<= (length rankings) (spec-hill-size spec))
(begin
(rankings (scores->rankings new-scores)))
(if (<= (length rankings) (spec-hill-size spec))
(begin
- (save-
scores new-score
s hill-dir)
+ (save-
hill-scores-and-rankings new-scores ranking
s hill-dir)
(hill-add-file challenger-file (prog-name challenger-prog) hill-dir))
(let ((loser (caar rankings)))
(hill-add-file challenger-file (prog-name challenger-prog) hill-dir))
(let ((loser (caar rankings)))
- (save-scores (filter (lambda (score)
- (not (or (equal? (car score) loser)
- (equal? (cadr score) loser))))
- new-scores)
- hill-dir)
+ (save-hill-scores-and-rankings (filter (lambda (score)
+ (not (or (equal? (car score) loser)
+ (equal? (cadr score) loser))))
+ new-scores)
+ (cdr rankings)
+ hill-dir)
(hill-remove loser hill-dir)))))))
;;; Hill initialization and specs
;;
(hill-remove loser hill-dir)))))))
;;; Hill initialization and specs
;;
-(define (
load
-scores dir)
+(define (
hill
-scores dir)
(with-input-from-file (make-pathname dir "scores") read))
(with-input-from-file (make-pathname dir "scores") read))
-(define (save-
scores score
s dir)
+(define (save-
hill-scores-and-rankings scores ranking
s dir)
(with-output-to-file (make-pathname dir "scores")
(with-output-to-file (make-pathname dir "scores")
- (lambda () (pretty-print scores))))
+ (lambda () (pretty-print scores)))
+ (with-output-to-file (make-pathname dir "rankings")
+ (lambda () (pretty-print rankings))))
-(define (
load
-spec dir)
+(define (
hill
-spec dir)
(with-input-from-file (make-pathname dir "spec") read))
(define (hill-files dir)
(glob (make-pathname dir "*.red")))
(define (hill-rankings dir)
(with-input-from-file (make-pathname dir "spec") read))
(define (hill-files dir)
(glob (make-pathname dir "*.red")))
(define (hill-rankings dir)
- (
scores->rankings (load-scores dir)
))
+ (
with-input-from-file (make-pathname dir "rankings") read
))
(define (hill-add-file file name dir)
(copy-file file (make-pathname dir (->string name) ".red")))
(define (hill-add-file file name dir)
(copy-file file (make-pathname dir (->string name) ".red")))
+(define (hill-remove-file name dir)
+ (delete-file (make-pathname dir name ".red")))
+
(define (make-spec core-size match-length games-per-match hill-size)
(list 'spec hill-size core-size match-length games-per-match))
(define (make-spec core-size match-length games-per-match hill-size)
(list 'spec hill-size core-size match-length games-per-match))
@@
-140,8
+146,9
@@
(print ";; ('spec hill-size core-size game-length games-per-match\n")
(pp (make-spec core-size game-length games-per-match hill-size))))
(with-output-to-file (make-pathname dir "scores")
(print ";; ('spec hill-size core-size game-length games-per-match\n")
(pp (make-spec core-size game-length games-per-match hill-size))))
(with-output-to-file (make-pathname dir "scores")
- (lambda ()
- (pp '())))))))
+ (lambda () (pp '())))
+ (with-output-to-file (make-pathname dir "rankings")
+ (lambda () (pp '())))))))
;;;; Main ;;;;
;;;; Main ;;;;
@@
-149,7
+156,7
@@
(define default-core-size 8000)
(define default-game-length 80000)
(define default-core-size 8000)
(define default-game-length 80000)
-(define default-games-per-match
1
)
+(define default-games-per-match
3
)
(define default-hill-size 10)
(define (print-usage)
(define default-hill-size 10)
(define (print-usage)
@@
-184,9
+191,14
@@
default-game-length
default-games-per-match))
(((or "-r" "--rankings") dir)
default-game-length
default-games-per-match))
(((or "-r" "--rankings") dir)
- (print "Warrior" "\t" "Score")
- (print "-=-=-=-" "\t" "=-=-=")
- (for-each (lambda (r) (print (car r) "\t" (cadr r))) (reverse (hill-rankings dir))))
+ (let ((rankings (reverse (hill-rankings dir))))
+ (if (null? rankings)
+ (print "No warriors on hill!")
+ (begin
+ (print rankings)
+ (print "Warrior" "\t" "Score")
+ (print "-=-=-=-" "\t" "=-=-=")
+ (for-each (lambda (r) (print (car r) "\t" (cadr r))) rankings)))))
((hill-dir challenger-file)
(challenge hill-dir challenger-file))
(else
((hill-dir challenger-file)
(challenge hill-dir challenger-file))
(else