implement plot script to plot priv scoreboard
This commit is contained in:
parent
bc82c7a528
commit
1a9bc9e11e
|
@ -2,8 +2,8 @@
|
|||
|
||||
;; library to interact with the AoC API and track solutions progress
|
||||
|
||||
(require net/uri-codec net/http-client)
|
||||
(provide aoc-fetch-input aoc-fetch-challenge aoc-submit-answer
|
||||
(require net/uri-codec net/http-client json)
|
||||
(provide aoc-fetch-input aoc-fetch-challenge aoc-submit-answer aoc-fetch-leaderboard
|
||||
aoc-complete? aoc-set-complete!)
|
||||
|
||||
(define *host* "adventofcode.com")
|
||||
|
@ -15,13 +15,17 @@
|
|||
(define base (build-path "/" year "day" day))
|
||||
(if endpoint (build-path base endpoint) base))
|
||||
|
||||
(define/contract (leaderboard-path year lb)
|
||||
(-> string? string? path?)
|
||||
(build-path "/" year "leaderboard" "private" "view" (string-append lb ".json")))
|
||||
|
||||
;; sets up necessary headers for API
|
||||
(define (make-headers session)
|
||||
(list (string-append "Cookie: session=" session)
|
||||
"Content-Type: application/x-www-form-urlencoded"))
|
||||
|
||||
;; http request helper
|
||||
(define (aoc-request year day endpoint session [method 'GET] [data #f])
|
||||
(define (aoc-request endpoint session [method 'GET] [data #f])
|
||||
(define (parse-headers hlist)
|
||||
(for/list ([h (in-list hlist)])
|
||||
(match h
|
||||
|
@ -48,12 +52,12 @@
|
|||
[stat
|
||||
(error "endpoint returned unexpected data\n status: " stat "\n response: "
|
||||
(port->bytes content))]))
|
||||
(do-request (path->string (puzzle-path year day endpoint)) (make-headers session) method data))
|
||||
(do-request (path->string endpoint) (make-headers session) method data))
|
||||
|
||||
;; gets the input file for a challenge
|
||||
(define/contract (aoc-fetch-input year day session)
|
||||
(-> string? string? string? input-port?)
|
||||
(aoc-request year day "input" session))
|
||||
(aoc-request (puzzle-path year day "input") session))
|
||||
|
||||
;; submits an answer to the server
|
||||
(define/contract (aoc-submit-answer year day session part answer)
|
||||
|
@ -61,7 +65,7 @@
|
|||
(define data `((level . ,(~a part))
|
||||
(answer . ,answer)))
|
||||
(define resp
|
||||
(port->bytes (aoc-request year day "answer" session 'POST (alist->form-urlencoded data))))
|
||||
(port->bytes (aoc-request (puzzle-path year day "answer") session 'POST (alist->form-urlencoded data))))
|
||||
|
||||
(match resp
|
||||
[(pregexp #px"That's the right answer")
|
||||
|
@ -77,7 +81,12 @@
|
|||
;; fetches the HTML page for a challenge
|
||||
(define/contract (aoc-fetch-challenge year day session)
|
||||
(-> string? string? string? input-port?)
|
||||
(aoc-request year day #f session))
|
||||
(aoc-request (puzzle-path year day #f) session))
|
||||
|
||||
;; gets a private leaderboard as json
|
||||
(define/contract (aoc-fetch-leaderboard year lb session)
|
||||
(-> string? string? string? jsexpr?)
|
||||
(read-json (aoc-request (leaderboard-path year lb) session)))
|
||||
|
||||
;; helper to generate entries for the challenge status file
|
||||
(define (day+part->key day part)
|
||||
|
|
|
@ -0,0 +1,106 @@
|
|||
#!/usr/bin/env racket
|
||||
#lang racket
|
||||
|
||||
(require "aoc-lib.rkt" plot)
|
||||
(plot-new-window? #t)
|
||||
|
||||
(define data
|
||||
(aoc-fetch-leaderboard (getenv "AOC_YEAR") (getenv "AOC_LEADERBOARD") (getenv "AOC_SESSION")))
|
||||
|
||||
(define (hash-ref* hash path [failure (lambda () (error "no such key" path))])
|
||||
(define (->symbol el)
|
||||
(match el
|
||||
[(? string?) (string->symbol el)]
|
||||
[(? number?) (string->symbol (number->string el))]
|
||||
[(? symbol?) el]))
|
||||
(define (do-failure) (if (procedure? failure) (failure) failure))
|
||||
(match path
|
||||
['() (do-failure)]
|
||||
[(cons (app ->symbol fst) '())
|
||||
(hash-ref hash fst failure)]
|
||||
[(cons (app ->symbol fst) rst)
|
||||
(if (hash-has-key? hash fst)
|
||||
(hash-ref* (hash-ref hash fst) rst failure)
|
||||
(do-failure))]))
|
||||
|
||||
(define members (hash-ref data 'members))
|
||||
(define max-pts (hash-count members))
|
||||
(define member-names (make-hash))
|
||||
|
||||
(struct tl-entry [mid day level] #:transparent)
|
||||
(define timeline (make-hash))
|
||||
|
||||
(for ([(mid-in val) (in-hash members)])
|
||||
(define mid (string->number (symbol->string mid-in)))
|
||||
(define name (hash-ref val 'name))
|
||||
(hash-set! member-names mid name)
|
||||
(for* ([day (in-range 1 26)] [level (in-range 1 3)])
|
||||
(match (hash-ref* val (list 'completion_day_level day level 'get_star_ts) #f)
|
||||
[#f (void)]
|
||||
[(app string->number (? number? time))
|
||||
(hash-update! timeline time (lambda (v) (cons (tl-entry mid day level) v)) '())])))
|
||||
|
||||
(define timestamps (sort (hash-keys timeline) <))
|
||||
;; vector of day to vector of part to ordered list of solvers
|
||||
; (define chals (for/vector ([day (in-range 1 26)]) (make-vector 2 '())))
|
||||
;
|
||||
; (for ([time (in-list timestamps)])
|
||||
; (for ([solve (in-list (hash-ref timeline time))])
|
||||
; (match-define (tl-entry mid day level) solve)
|
||||
; (define old (vector-ref (vector-ref chals (sub1 day)) (sub1 level)))
|
||||
; (vector-set! (vector-ref chals (sub1 day)) (sub1 level) (append old (list mid)))))
|
||||
;
|
||||
; (define (total-points mem)
|
||||
; ;; day 1 is worth no points u___u
|
||||
; (for*/sum ([day (in-range 2 26)] [level (in-range 1 3)])
|
||||
; (define solves-for-day (vector-ref (vector-ref chals (sub1 day)) (sub1 level)))
|
||||
; (match (index-of solves-for-day mem)
|
||||
; [#f 0]
|
||||
; [x (- max-pts x)])))
|
||||
; (total-points 1067937)
|
||||
|
||||
(define point-values (make-hash))
|
||||
(for* ([day (in-range 1 26)] [level (in-range 1 3)])
|
||||
(hash-set! point-values (cons day level)
|
||||
(if (= day 1)
|
||||
0 ; day 1 is worth no points u___u
|
||||
max-pts)))
|
||||
|
||||
(define point-tls (make-hash))
|
||||
(for ([(mid _) (in-hash member-names)])
|
||||
(hash-set! point-tls mid (vector)))
|
||||
|
||||
(define (get-last-pts data)
|
||||
(if (vector-empty? data)
|
||||
0
|
||||
(vector-ref (vector-ref data (sub1 (vector-length data))) 1)))
|
||||
|
||||
(define (set-pts! mid time pts)
|
||||
(hash-update! point-tls mid
|
||||
(lambda (m-tl)
|
||||
(vector-append m-tl (vector (vector time pts))))))
|
||||
|
||||
(for ([time (in-list timestamps)])
|
||||
(for ([solve (in-list (hash-ref timeline time))])
|
||||
(match-define (tl-entry mid day level) solve)
|
||||
(define key (cons day level))
|
||||
(define m-tl (hash-ref point-tls mid))
|
||||
(define old-pts (get-last-pts m-tl))
|
||||
(define pts (hash-ref point-values key))
|
||||
(hash-set! point-values key (max 0 (sub1 pts)))
|
||||
(set-pts! mid time (+ old-pts pts))))
|
||||
|
||||
(define now (current-seconds))
|
||||
(for ([(mid data) (in-hash point-tls)])
|
||||
(define pts (get-last-pts data))
|
||||
(set-pts! mid now pts))
|
||||
|
||||
(plot-x-ticks (date-ticks))
|
||||
(plot (for/list ([(mid data) (in-hash point-tls)])
|
||||
(lines data
|
||||
#:label (hash-ref member-names mid)
|
||||
#:color mid
|
||||
#:style mid
|
||||
#:width 2))
|
||||
#:x-label "date/time"
|
||||
#:y-label "points")
|
Loading…
Reference in New Issue