haskal
/
aoc2020
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add scribble view for plot lol

This commit is contained in:
xenia 2020-12-04 23:59:00 -05:00
parent 5365272e27
commit 06ab477340
3 changed files with 99 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

182
scripts/plot
View File

@ -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))

3
scripts/plot.css Normal file
View File

@ -0,0 +1,3 @@
html, body { background: black; color: white; font-family: monospace; }
h1, h2, h3, p { font-family: monospace; }

10
scripts/plot.scrbl Normal file
View File

@ -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))