~edwargix/tallyard

19715feee8f5a93f67a8e41c31e983322af72ce0 — David Florness 5 years ago 9ec1746
Decode ranked results and display them
1 files changed, 46 insertions(+), 30 deletions(-)

M client.rkt
M client.rkt => client.rkt +46 -30
@@ 76,11 76,13 @@
                            (loop 3))])
           (get bulletin "/peers"))))
      (Listof String))))
  (define peer-count (cast (length peer-inputs) Positive-Integer))
  (newline)

  (displayln "retrieving candidates...")
  (define candidates (cast (json-response-body
                            (get bulletin "/candidates")) (Listof String)))
  (define cand-count (cast (length candidates) Positive-Integer))

  (displayln "Candidates:")
  (for ([i (in-naturals)]


@@ 93,30 95,28 @@
                          (λ ([e : exn])
                            (displayln (exn-message e))
                            (loop))])
           (let* ([num-cands (length candidates)]
                  [entries
                   (map
                    (λ ([s : String]) : Integer
                       (let ([entry (assert (string->number s)
                                            exact-integer?)])
                         (when (or (< entry 1) (> entry num-cands))
                           (raise-user-error
                            (format "every entry in your ballot should be a valid integer ∈ [~a,~a]"
                                    1 num-cands)))
                         (sub1 entry)))
                    (string-split
                     (readline
                      "Rank the candidates (most to least preferable): ")))])
           (let ([entries
                  (map
                   (λ ([s : String]) : Integer
                      (let ([entry (assert (string->number s)
                                           exact-integer?)])
                        (when (or (< entry 1) (> entry cand-count))
                          (raise-user-error
                           (format "every entry in your ballot should be a valid integer ∈ [~a,~a]"
                                   1 cand-count)))
                        (sub1 entry)))
                   (string-split
                    (readline
                     "Rank the candidates (most to least preferable): ")))])
             (when (not (members-unique? entries))
               (raise-user-error "every entry in your ballot must be unique"))
             (let* ([m num-cands]
             (let* ([m cand-count]
                    [n m]
                    [arr (array->mutable-array
                          (make-array (vector m n) 0))]
                    [num-peers (cast (length peer-inputs) Positive-Integer)])
                          (make-array (vector m n) 0))])
               (let loop ([entry (car entries)]
                          [rst (cdr entries)]
                          [remaining (set-remove (list->set (range num-cands))
                          [remaining (set-remove (list->set (range cand-count))
                                                 (car entries))])
                 (for ([other remaining])
                   (array-set! arr (vector entry other) 1))


@@ 130,7 130,7 @@
                  (bytes-append bstr
                                (integer->bytes
                                 (array-ref arr (vector i j))
                                 (cast (min (integer-bytes-length num-peers #t) 1)
                                 (cast (min (integer-bytes-length peer-count #t) 1)
                                       Positive-Integer)
                                 #t)))
                #t))))))


@@ 200,16 200,32 @@
                        (Immutable-HashTable Symbol String)))])
                  (values (hex-string->integer (symbol->string k))
                          (hex-string->integer v)))])
      (matrix-ref
       (matrix-solve
        ; M
        (for*/matrix k k ([x peer-inputs]
                          [p (range k)]) : Number
                     (expt x p))
        ; B
        (for*/matrix k 1 ([x peer-inputs]) : Number
                     (hash-ref sums x)))
       0 0)))
      (cast
       (matrix-ref
        (matrix-solve
         ; M
         (for*/matrix k k ([x peer-inputs]
                           [p (range k)]) : Number
                      (expt x p))
         ; B
         (for*/matrix k 1 ([x peer-inputs]) : Number
                      (hash-ref sums x)))
        0 0)
       Integer)))
  (newline)

  (displayln (format "Result: ~a" constant)))
  (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))))))))