X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=jars.git;a=blobdiff_plain;f=koth.scm;h=2324e9cdca9e2441f19adb0eb7a28374f9bce5b8;hp=c14008dd45f86d139d1eaeff0948cd0d9b2d5bad;hb=7290d31ea915ea868ca34857e62fea9133db33f8;hpb=d4f97cb3c89307474ca8eaa812b739af35c2b7f3 diff --git a/koth.scm b/koth.scm index c14008d..2324e9c 100644 --- a/koth.scm +++ b/koth.scm @@ -17,31 +17,60 @@ (define (file->prog file) (string->prog (with-input-from-file fname read))) -(define (run-all-matches challenger-file other-files) +(define (score-challenger-matches spec challenger-file other-files) (let ((challenger-prog (file->prog challenger-file)) (challenger-name (prog-name challenger-prog)) (other-progs (apply file->prog other-files))) (map (lambda (other-prog) - (let ((other-name (prog-name other-prog)) - (result (run-match challenger-prog other-prog))) - (cond ((or (= (length result) 2) - (= (length result) 0)) - `((,challenger-name 1) (,other-name 1))) - ((eq? (queue-name (car result)) challenger-name) - `((,challenger-name 3) (,other-name 0))) - (else - `((,challenger-name 0) (,other-name 3)))))) + (score-match spec challenger-prog other-prog)) other-progs))) -(define (run-match spec . progs) - (let loop ((remaining (spec-games-per-match spec))) - (let* ((core (make-core (spec-core-size spec) INITIAL-INSTR)) - (queues (install-progs core (list challenger-prog other-prog)))) - (run-mars core queues)) - (loop (- remaining 1)))) - -;;; Score keeping and specs +(define (score-match spec prog1 prog2) + (let ((tally + (foldl + (lambda (score-a score-b) + (list (+ (car score-a) (car score-b)) + (+ (cadr score-a) (cadr score-b)))) + (list 0 0) + (let loop ((remaining (spec-games-per-match spec))) + (loop (- remaining 1)))))) + `((,(prog-name prog1 ,(car tally))) + (,(prog-name prog2 ,(cadr tally)))))) + +(define (score-game spec prog1 prog2) + (let* ((core (make-core (spec-core-size spec) INITIAL-INSTR)) + (queues (install-progs core (list prog1 prog2))) + (result (run-mars core queues (spec-game-length spec)))) + (cond + ((null? result) (error "Invalid game result.")) + ((= (length result) 1) + (let ((winner-name (caar result))) + (if (eq? winner-name name1) + '(3 0) + '(0 3)))) + (else + '(1 1))))) + +(define (count-scores-for-progs progs) + (map (lambda (prog) + (count-scores-for-name scores (prog-name prog))) + progs)) + +(define (count-scores-for-name scores name) + (let loop ((score 0) + (remaining-scores scores)) + (if (null? remaining-scores) + score + (loop + (let ((this-score (car remaining-scores))) + (cond + ((eq? (caar this-score) name) + (loop (+ score (cadar this-score)) (cdr remaining-scores))) + ((eq? (caadr this-score) name) + (loop (+ score (cadadr this-score)) (cdr remaining-scores))))))))) + +;;; Hill initialization and specs ;; (define (load-scores dir)