diff --git a/scripts/plot b/scripts/plot index a7b4d13..9a68e96 100755 --- a/scripts/plot +++ b/scripts/plot @@ -1,112 +1,102 @@ #!/usr/bin/env racket #lang racket -(require "aoc-lib.rkt" plot) -(plot-new-window? #t) +(require "aoc-lib.rkt" plot/no-gui) +(provide make-plot) -(define data - (aoc-fetch-leaderboard (getenv "AOC_YEAR") (getenv "AOC_LEADERBOARD") (getenv "AOC_SESSION"))) +(define (make-plot plot-func) + (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 (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)) + (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)) + (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 ([(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) <)) + + (define point-values (make-hash)) (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)) '())]))) + (hash-set! point-values (cons day level) + (if (= day 1) + 0 ; day 1 is worth no points u___u + max-pts))) -(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-tls (make-hash)) + (for ([(mid _) (in-hash member-names)]) + (hash-set! point-tls mid (vector))) -(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 (get-last-pts data) + (if (vector-empty? data) + 0 + (vector-ref (vector-ref data (sub1 (vector-length data))) 1))) -(define point-tls (make-hash)) -(for ([(mid _) (in-hash member-names)]) - (hash-set! point-tls mid (vector))) + (define (set-pts! mid time pts) + (hash-update! point-tls mid + (lambda (m-tl) + (vector-append m-tl (vector (vector time (get-last-pts m-tl)) + (vector time pts)))))) -(define (get-last-pts data) - (if (vector-empty? data) - 0 - (vector-ref (vector-ref data (sub1 (vector-length data))) 1))) + (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 (set-pts! mid time pts) - (hash-update! point-tls mid - (lambda (m-tl) - (vector-append m-tl (vector (vector time (get-last-pts m-tl)) - (vector time pts)))))) + (define now (current-seconds)) + (for ([(mid data) (in-hash point-tls)]) + (define pts (get-last-pts data)) + (set-pts! mid now 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)))) + (plot-x-ticks (date-ticks)) + (define ordered-mids + (sort (hash-keys point-tls) + (lambda (a b) + (>= (get-last-pts (hash-ref point-tls a)) (get-last-pts (hash-ref point-tls b)))))) + (plot-func + (for/list ([mid (in-list ordered-mids)]) + (lines (hash-ref point-tls mid) + #:label (format "~a (~a pts)" (hash-ref member-names mid) + (get-last-pts (hash-ref point-tls mid))) + #:color mid + #:style mid + #:width 2)) + #:x-label "date/time" + #:y-label "points")) -(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)) -(define ordered-mids - (sort (hash-keys point-tls) - (lambda (a b) - (>= (get-last-pts (hash-ref point-tls a)) (get-last-pts (hash-ref point-tls b)))))) -(plot (for/list ([mid (in-list ordered-mids)]) - (lines (hash-ref point-tls mid) - #:label (format "~a (~a pts)" (hash-ref member-names mid) - (get-last-pts (hash-ref point-tls mid))) - #:color mid - #:style mid - #:width 2)) - #:x-label "date/time" - #:y-label "points") +(module+ main + (require plot) + (plot-new-window? #t) + (make-plot plot)) diff --git a/scripts/plot.css b/scripts/plot.css new file mode 100644 index 0000000..59b0ea2 --- /dev/null +++ b/scripts/plot.css @@ -0,0 +1,3 @@ +html, body { background: black; color: white; font-family: monospace; } + +h1, h2, h3, p { font-family: monospace; } diff --git a/scripts/plot.scrbl b/scripts/plot.scrbl new file mode 100644 index 0000000..9ca2bbc --- /dev/null +++ b/scripts/plot.scrbl @@ -0,0 +1,10 @@ +#lang scribble/base + +@(require plot/no-gui racket "plot") + +@title[#:style '(toc-hidden no-sidebar no-index no-toc+aux)]{BLÁHAJ score chart} + +meow + +@(parameterize ([plot-width 2048] [plot-height 1024]) + (make-plot plot-pict))