1 files changed, 79 insertions(+), 17 deletions(-)
M client.rkt
M client.rkt => client.rkt +79 -17
@@ 131,8 131,9 @@
(bytes-append bstr
(integer->bytes
(array-ref arr (vector i j))
- (cast (min (integer-bytes-length peer-count #t) 1)
- Positive-Integer)
+ (cast
+ (min (integer-bytes-length peer-count #t) 1)
+ Positive-Integer)
#t)))
#t))))))
@@ 221,18 222,79 @@
Integer)))
(newline)
- (let* ([partial-size (cast (integer-bytes-length peer-count #t) Positive-Integer)]
- [bstr (integer->bytes constant (* partial-size cand-count cand-count) #t)]
- [arr (for/array: #:shape (vector cand-count cand-count)
- ([section : Natural (in-range 0 (bytes-length bstr) partial-size)])
- : Integer
- (bytes->integer bstr #t #t section (+ section partial-size)))]
- [candidates (list->vector candidates)])
- (for* ([i (in-range cand-count)]
- [j (in-range cand-count)]
- #:when (< i j))
- (displayln (format "~a over ~a: ~a"
- (vector-ref candidates i)
- (vector-ref candidates j)
- (- (array-ref arr (vector i j))
- (array-ref arr (vector j i))))))))
+ (displayln ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; RESULTS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
+ (define pairwise-prefs
+ (let* ([partial-size (cast (integer-bytes-length peer-count #t)
+ Positive-Integer)]
+ [bstr (integer->bytes constant
+ (* partial-size cand-count cand-count)
+ #t)]
+ [arr (for/array: #:shape (vector cand-count cand-count)
+ ([section : Natural (in-range 0
+ (bytes-length bstr)
+ partial-size)])
+ : Integer
+ (bytes->integer bstr #t #t section
+ (+ section partial-size)))]
+ [candidates (list->vector candidates)])
+ (for*/hash : (HashTable (Pairof Natural Natural) Integer)
+ ([i cand-count]
+ [j cand-count]
+ #:when (not (eqv? i j)))
+ (values (cons i j)
+ (let ([prefer-i-over-j (array-ref arr (vector i j))])
+ (displayln (format "~a over ~a: ~a"
+ (vector-ref candidates i)
+ (vector-ref candidates j)
+ prefer-i-over-j))
+ prefer-i-over-j)))))
+
+ (define strongest-paths
+ (let ([p : (HashTable (Pairof Natural Natural) Integer)
+ (make-hash)])
+ (for* ([i cand-count]
+ [j cand-count]
+ #:when (not (eqv? i j)))
+ (hash-set! p (cons i j)
+ (if (> (hash-ref pairwise-prefs (cons i j))
+ (hash-ref pairwise-prefs (cons j i)))
+ (hash-ref pairwise-prefs (cons i j))
+ 0)))
+ (for* ([i cand-count]
+ [j cand-count]
+ #:when (not (eqv? i j))
+ [k cand-count]
+ #:when (and (not (eqv? i k)) (not (eqv? j k))))
+ (hash-update! p (cons j k)
+ (λ ([c : Integer])
+ (cast
+ (max c (min (hash-ref p (cons j i))
+ (hash-ref p (cons i k))))
+ Integer))))
+ p))
+
+ (define rankings
+ (let loop : (Listof (Setof Natural))
+ ([remaining : (Setof Natural)
+ (list->set (range cand-count))])
+ (if (set-empty? remaining)
+ empty
+ (let ([winners
+ (for/set : (Setof Natural)
+ ([cand : Natural remaining]
+ #:when
+ (for/and : Boolean
+ ([other : Natural remaining]
+ #:when (not (eqv? cand other)))
+ (>= (hash-ref strongest-paths
+ (cons cand other))
+ (hash-ref strongest-paths
+ (cons other cand)))))
+ cand)])
+ (cons winners (loop (set-subtract remaining winners)))))))
+
+ (displayln "Rankings:")
+ (for ([i (in-naturals)]
+ [rank rankings])
+ (for ([r rank])
+ (displayln (format "~a) ~a" (add1 i) (list-ref candidates r))))))