From 15a24a473365f015f18db5056ca95ee4bb7f633c Mon Sep 17 00:00:00 2001 From: David Florness Date: Sun, 10 Nov 2019 09:34:25 -0700 Subject: [PATCH] First attempt at results function It doesn't handle ties yet --- server.rkt | 31 ++++++++++++++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/server.rkt b/server.rkt index 0f8e572..ea5cbd5 100644 --- a/server.rkt +++ b/server.rkt @@ -35,7 +35,7 @@ (let foo ([i 0]) (if (> (bytes-ref bstr i) 0) (let ([s (bytes->string/utf-8 (subbytes bstr i))]) - (set! votes (cons (string-split s ":") votes)) + (set! votes (cons (map string->number (string-split s ":")) votes)) (println votes)) (foo (add1 i))))) @@ -60,6 +60,35 @@ 200 #f (current-seconds) #"application/octet-stream" empty (list (integer->bytes n (/ keylen 8) #f)))) +(define (results votes) + (let res ([votes votes] + [firsts (make-immutable-hash + (for/list ([i (in-range (length cands))]) + (cons i (list 0))))] + [done (list)]) + (if (empty? votes) + (if (hash-empty? firsts) + done + (let ([last-place (caar (sort (hash->list firsts) + (λ (p1 p2) (< (cadr p1) (cadr p2)))))]) + (res (cdr (hash-ref firsts last-place)) + (hash-remove firsts last-place) + (cons last-place done)))) + (let ([vote (car votes)]) + (res (cdr votes) + (let insert-first ([first (car vote)] + [left (cdr vote)]) + (if (hash-has-key? firsts first) + (hash-update firsts first + (λ (p) (cons (add1 (car p)) + (if (empty? left) + (cdr p) + (cons left (cdr p)))))) + (if (empty? left) + firsts + (insert-first (car left) (cdr left))))) + done))))) + (define-values (dispatcher url-generator) (dispatch-rules [("candidates") candidates] -- 2.38.4