initial commit
This commit is contained in:
commit
0d483e2251
|
|
@ -0,0 +1,4 @@
|
|||
.envrc
|
||||
/.status.rktd
|
||||
*.zo
|
||||
*.dep
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
#lang curly-fn racket
|
||||
|
||||
(require "scripts/aoc.rkt")
|
||||
|
||||
;; solution for day 1
|
||||
|
||||
(define (part1 input)
|
||||
(for/sum ([line (in-list input)])
|
||||
(define nums (regexp-match* #px"[0-9]" line))
|
||||
(string->number (string-append (first nums) (last nums)))))
|
||||
|
||||
(define (part2 input)
|
||||
(define (line->result line)
|
||||
(define match1
|
||||
(first (regexp-match #px"([0-9]|one|two|three|four|five|six|seven|eight|nine)" line)))
|
||||
(define match2
|
||||
(string-reverse (first (regexp-match #px"([0-9]|eno|owt|eerht|ruof|evif|xis|neves|thgie|enin)"
|
||||
(string-reverse line)))))
|
||||
(match-define (list num1 num2)
|
||||
(for/list ([z (in-list (list match1 match2))])
|
||||
(match z
|
||||
["one" "1"]
|
||||
["two" "2"]
|
||||
["three" "3"]
|
||||
["four" "4"]
|
||||
["five" "5"]
|
||||
["six" "6"]
|
||||
["seven" "7"]
|
||||
["eight" "8"]
|
||||
["nine" "9"]
|
||||
[v v])))
|
||||
(string->number (string-append num1 num2)))
|
||||
(apply + (map line->result input)))
|
||||
|
||||
(module+ main
|
||||
(define input (file->lines "inputs/1"))
|
||||
(answer 1 1 (time (part1 input)))
|
||||
(answer 1 2 (time (part2 input)))
|
||||
(displayln "meow"))
|
||||
|
|
@ -0,0 +1,228 @@
|
|||
#lang racket/base
|
||||
|
||||
;; original source: https://github.com/renatoathaydes/ansi-color
|
||||
;; modified to provide font-style because i need that bold
|
||||
|
||||
(require racket/match)
|
||||
|
||||
(provide color-display
|
||||
color-displayln
|
||||
ansi-color?
|
||||
with-colors
|
||||
background-color
|
||||
foreground-color
|
||||
font-style
|
||||
erase-line)
|
||||
|
||||
;; Color and decoration escape definitions
|
||||
|
||||
(define reset "\033[0m")
|
||||
(define erase-line "\033[K")
|
||||
|
||||
(define (bkg-color256 code)
|
||||
(string-append "\033[48;5;" (number->string code) "m"))
|
||||
|
||||
(define (fore-color256 code)
|
||||
(string-append "\033[38;5;" (number->string code) "m"))
|
||||
|
||||
(define decoration-map
|
||||
#hasheq(
|
||||
(underline . "\033[4m")
|
||||
(bold . "\033[1m")
|
||||
(reversed . "\033[7m")))
|
||||
|
||||
(define fore-color-map
|
||||
#hasheq(
|
||||
(black . "\033[30m")
|
||||
(red . "\033[31m")
|
||||
(green . "\033[32m")
|
||||
(yellow . "\033[33m")
|
||||
(blue . "\033[34m")
|
||||
(magenta . "\033[35m")
|
||||
(cyan . "\033[36m")
|
||||
(white . "\033[37m")
|
||||
(b-black . "\033[30;1m")
|
||||
(b-red . "\033[31;1m")
|
||||
(b-green . "\033[32;1m")
|
||||
(b-yellow . "\033[33;1m")
|
||||
(b-blue . "\033[34;1m")
|
||||
(b-magenta . "\033[35;1m")
|
||||
(b-cyan . "\033[36;1m")
|
||||
(b-white . "\033[37;1m")))
|
||||
|
||||
(define bkg-color-map
|
||||
#hasheq(
|
||||
(black . "\033[40m")
|
||||
(red . "\033[41m")
|
||||
(green . "\033[42m")
|
||||
(yellow . "\033[43m")
|
||||
(blue . "\033[44m")
|
||||
(magenta . "\033[45m")
|
||||
(cyan . "\033[46m")
|
||||
(white . "\033[47m")
|
||||
(b-black . "\033[40;1m")
|
||||
(b-red . "\033[41;1m")
|
||||
(b-green . "\033[42;1m")
|
||||
(b-yellow . "\033[43;1m")
|
||||
(b-blue . "\033[44;1m")
|
||||
(b-magenta . "\033[45;1m")
|
||||
(b-cyan . "\033[46;1m")
|
||||
(b-white . "\033[47;1m")))
|
||||
|
||||
;; customization parameters
|
||||
|
||||
(define background-color (make-parameter ""
|
||||
(lambda (arg) (as-escape-seq #t arg))))
|
||||
|
||||
(define foreground-color (make-parameter ""
|
||||
(lambda (arg) (as-escape-seq #f arg))))
|
||||
|
||||
(define font-style (make-parameter ""
|
||||
(lambda (arg) (as-style-seq arg))))
|
||||
|
||||
(define no-reset (make-parameter #f))
|
||||
|
||||
;; implementation
|
||||
|
||||
(define (ansi-color? x)
|
||||
(or
|
||||
(and (integer? x) (<= x 255) (>= x 0))
|
||||
(and (symbol? x) (hash-has-key? fore-color-map x))))
|
||||
|
||||
(define (as-escape-seq bkg? arg)
|
||||
(define (raise-arg-error)
|
||||
(raise-arguments-error 'color
|
||||
"Cannot convert argument to color (not a valid symbol or integer in the 0-255 range)"
|
||||
"color"
|
||||
arg))
|
||||
(define map (if bkg? bkg-color-map fore-color-map))
|
||||
(match arg
|
||||
[(? null?) ""]
|
||||
["" ""]
|
||||
[(? symbol? s) (hash-ref map s (lambda () (raise-arg-error)))]
|
||||
[(? integer? x)
|
||||
#:when (and (<= x 255) (>= x 0))
|
||||
((if bkg? bkg-color256 fore-color256) x)]
|
||||
[_ (raise-arg-error)]))
|
||||
|
||||
(define (as-style-seq arg)
|
||||
(define (raise-arg-error)
|
||||
(raise-arguments-error 'style
|
||||
"Cannot convert argument to style (not a valid symbol)"
|
||||
"style"
|
||||
arg))
|
||||
(match arg
|
||||
["" ""]
|
||||
[(? null?) ""]
|
||||
[(? symbol? s) (hash-ref decoration-map s (lambda () (raise-arg-error)))]
|
||||
[_ (raise-arg-error)]))
|
||||
|
||||
(define (needs-reset? bkg fore style)
|
||||
(cond [(no-reset) #f]
|
||||
[else (not (and (equal? "" bkg)
|
||||
(equal? "" fore)
|
||||
(equal? "" style)))]))
|
||||
|
||||
(define (color-display datum [out (current-output-port)])
|
||||
(let* ([bkg (background-color)]
|
||||
[fore (foreground-color)]
|
||||
[style (font-style)]
|
||||
[-reset (if (needs-reset? bkg fore style) reset "")])
|
||||
(display (string-append bkg fore style datum -reset) out)))
|
||||
|
||||
(define (color-displayln datum [out (current-output-port)])
|
||||
(color-display datum out)
|
||||
(newline out))
|
||||
|
||||
(define with-colors
|
||||
(case-lambda
|
||||
[(bkg-color fore-color proc)
|
||||
(parameterize ([background-color bkg-color]
|
||||
[foreground-color fore-color]
|
||||
[no-reset #t])
|
||||
(color-display "") ; sets the colors in the terminal
|
||||
(proc)
|
||||
(display reset))] ; reset colors in the terminal
|
||||
[(fore-color proc)
|
||||
(with-colors null fore-color proc)]))
|
||||
|
||||
|
||||
;; TESTS
|
||||
|
||||
(module+ test
|
||||
|
||||
(require rackunit)
|
||||
|
||||
(check-eq? (needs-reset? "" "" "") #f)
|
||||
(check-eq? (needs-reset? "red" "" "") #t)
|
||||
(check-eq? (needs-reset? "" "blue" "") #t)
|
||||
(check-eq? (needs-reset? "red" "green" "") #t)
|
||||
(check-eq? (needs-reset? "red" "green" "underline") #t)
|
||||
(check-eq? (needs-reset? "" "" "underline") #t)
|
||||
(check-eq? (parameterize ([no-reset #t])
|
||||
(needs-reset? "" "" "")) #f)
|
||||
(check-eq? (parameterize ([no-reset #t])
|
||||
(needs-reset? "red" "green" "reversed")) #f)
|
||||
|
||||
(check-eq? (ansi-color? 'red) #t)
|
||||
(check-eq? (ansi-color? 'white) #t)
|
||||
(check-eq? (ansi-color? 'black) #t)
|
||||
(check-eq? (ansi-color? 'b-red) #t)
|
||||
(check-eq? (ansi-color? 'b-white) #t)
|
||||
(check-eq? (ansi-color? 'b-black) #t)
|
||||
(check-eq? (ansi-color? 'some) #f)
|
||||
(check-eq? (ansi-color? 'foo-bar) #f)
|
||||
(check-eq? (ansi-color? 0) #t)
|
||||
(check-eq? (ansi-color? 1) #t)
|
||||
(check-eq? (ansi-color? 10) #t)
|
||||
(check-eq? (ansi-color? 200) #t)
|
||||
(check-eq? (ansi-color? 255) #t)
|
||||
(check-eq? (ansi-color? 256) #f)
|
||||
(check-eq? (ansi-color? -1) #f)
|
||||
(check-eq? (ansi-color? -10) #f)
|
||||
(check-eq? (ansi-color? "blue") #f)
|
||||
(check-eq? (ansi-color? #t) #f)
|
||||
|
||||
(define (wrap-in-color color text)
|
||||
(string-append (hash-ref fore-color-map color) text reset))
|
||||
|
||||
(define (get-output proc)
|
||||
(let ([out (open-output-string)])
|
||||
(parameterize ([current-output-port out])
|
||||
(proc)
|
||||
(get-output-string out))))
|
||||
|
||||
; tests for color-display
|
||||
(let ([hello-uncolored (get-output (lambda () (color-display "hello")))]
|
||||
[world-fore-red (get-output (lambda ()
|
||||
(parameterize ([background-color 'red])
|
||||
(color-display "world"))))]
|
||||
[tree-fore-blue (get-output (lambda ()
|
||||
(parameterize ([foreground-color 'blue])
|
||||
(color-display "tree"))))]
|
||||
[animal-yellow-black (get-output (lambda ()
|
||||
(parameterize ([background-color 'yellow]
|
||||
[foreground-color 'black])
|
||||
(color-display "animal"))))]
|
||||
[something-bold (get-output (lambda ()
|
||||
(parameterize ([font-style 'bold])
|
||||
(color-display "something"))))])
|
||||
|
||||
(check-equal? hello-uncolored "hello")
|
||||
(check-equal? world-fore-red "\033[41mworld\033[0m")
|
||||
(check-equal? tree-fore-blue "\033[34mtree\033[0m")
|
||||
(check-equal? animal-yellow-black "\033[43m\033[30manimal\033[0m")
|
||||
(check-equal? something-bold "\033[1msomething\033[0m"))
|
||||
|
||||
; tests for with-colors
|
||||
(let ([blue-and-white (get-output (lambda () (with-colors 'blue 'white (lambda () (display "b-a-w")))))]
|
||||
[red-and-green (get-output (lambda () (with-colors 'red 'green (lambda () (display "r-a-g")))))]
|
||||
[blue (get-output (lambda () (with-colors 'blue (lambda () (display "b")))))]
|
||||
[white (get-output (lambda () (with-colors 'white (lambda () (display "w")))))])
|
||||
|
||||
(check-equal? blue-and-white "\033[44m\033[37mb-a-w\033[0m")
|
||||
(check-equal? red-and-green "\033[41m\033[32mr-a-g\033[0m")
|
||||
(check-equal? blue "\033[34mb\033[0m")
|
||||
(check-equal? white "\033[37mw\033[0m"))
|
||||
|
||||
)
|
||||
|
|
@ -0,0 +1,117 @@
|
|||
#lang racket
|
||||
|
||||
;; library to interact with the AoC API and track solutions progress
|
||||
|
||||
(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")
|
||||
(define *status-file* ".status.rktd")
|
||||
|
||||
;; generates API paths
|
||||
(define/contract (puzzle-path year day endpoint)
|
||||
(-> string? string? (or/c "input" "answer" false/c) path?)
|
||||
(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 endpoint session [method 'GET] [data #f])
|
||||
(define (parse-headers hlist)
|
||||
(for/list ([h (in-list hlist)])
|
||||
(match h
|
||||
[(pregexp #px"^([^:]+): (.*?)$" (list _ k v))
|
||||
(cons (string->symbol (string-downcase (bytes->string/utf-8 k)))
|
||||
(bytes->string/utf-8 v))]
|
||||
[x (cons 'unknown x)])))
|
||||
|
||||
(define (do-request path headers method data)
|
||||
(define-values [status headers-out content]
|
||||
(http-sendrecv *host* path #:ssl? #t #:headers headers #:method method #:data data))
|
||||
(define headers-out/parsed (parse-headers headers-out))
|
||||
|
||||
(match status
|
||||
[(pregexp #px"^HTTP/1\\.[10] 200") content]
|
||||
[(pregexp #px"^HTTP/1\\.[10] 302")
|
||||
(define location (cdr (or (assoc 'location headers-out/parsed)
|
||||
(error "got 302 with no location"))))
|
||||
(printf "got redirect to ~a\n" location)
|
||||
(close-input-port content)
|
||||
(do-request location headers 'GET #f)]
|
||||
[(pregexp #px"^HTTP/1\\.[10] 404")
|
||||
(error "endpoint returned 404\n response: " (port->bytes content))]
|
||||
[stat
|
||||
(error "endpoint returned unexpected data\n status: " stat "\n response: "
|
||||
(port->bytes content))]))
|
||||
(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 (puzzle-path year day "input") session))
|
||||
|
||||
;; submits an answer to the server
|
||||
(define/contract (aoc-submit-answer year day session part answer)
|
||||
(-> string? string? string? (or/c 1 2 "1" "2") string? (or/c symbol? bytes?))
|
||||
(define data `((level . ,(~a part))
|
||||
(answer . ,answer)))
|
||||
(define resp
|
||||
(port->bytes (aoc-request (puzzle-path year day "answer") session 'POST (alist->form-urlencoded data))))
|
||||
|
||||
(match resp
|
||||
[(pregexp #px"That's the right answer")
|
||||
(aoc-set-complete! day part)
|
||||
'answer-correct]
|
||||
[(pregexp #px"That's not the right answer") 'answer-incorrect]
|
||||
[(pregexp #px"You gave an answer too recently") 'rate-limited]
|
||||
[(pregexp #px"fifty stars")
|
||||
(aoc-set-complete! day part)
|
||||
'year-complete]
|
||||
[(pregexp #px"Did you already complete it?")
|
||||
(aoc-set-complete! day part)
|
||||
'already-completed]
|
||||
[x x]))
|
||||
|
||||
;; fetches the HTML page for a challenge
|
||||
(define/contract (aoc-fetch-challenge year day session)
|
||||
(-> string? string? string? input-port?)
|
||||
(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)
|
||||
(when (string? day)
|
||||
(set! day (string->number day)))
|
||||
(when (string? part)
|
||||
(set! part (string->number part)))
|
||||
(cons day part))
|
||||
|
||||
;; get the challenge status file
|
||||
(define (aoc-get-status)
|
||||
(cond [(file-exists? *status-file*)
|
||||
(call-with-input-file *status-file* read)]
|
||||
[else '()]))
|
||||
|
||||
;; is a challenge complete already?
|
||||
(define (aoc-complete? day part)
|
||||
(set-member? (aoc-get-status) (day+part->key day part)))
|
||||
|
||||
;; mark a challenge as completed
|
||||
(define (aoc-set-complete! day part)
|
||||
(define status (set-add (aoc-get-status) (day+part->key day part)))
|
||||
(call-with-output-file
|
||||
*status-file* (lambda (out) (write status out))
|
||||
#:mode 'binary #:exists 'replace))
|
||||
|
|
@ -0,0 +1,83 @@
|
|||
#lang curly-fn racket
|
||||
|
||||
;; utilities for every challenge script
|
||||
|
||||
(require "aoc-lib.rkt" (prefix-in is: data/integer-set) graph threading syntax/parse/define
|
||||
(for-syntax racket/syntax))
|
||||
(provide answer aoc-finish dbg memoize define/memoized
|
||||
band bor bxor bnot bshl bshr bset? bfield
|
||||
string-reverse
|
||||
maximum-bipartite-matching/stable
|
||||
(all-from-out data/integer-set graph syntax/parse/define threading)
|
||||
(for-syntax (all-from-out racket/syntax)))
|
||||
|
||||
;; in-expression debug print, uwu
|
||||
(define (dbg x)
|
||||
(pretty-write x)
|
||||
x)
|
||||
|
||||
(define band bitwise-and)
|
||||
(define bor bitwise-ior)
|
||||
(define bxor bitwise-xor)
|
||||
(define bnot bitwise-not)
|
||||
(define bshl arithmetic-shift)
|
||||
(define bshr #{arithmetic-shift %1 (- %2)})
|
||||
(define bset? bitwise-bit-set?)
|
||||
(define bfield bitwise-bit-field)
|
||||
|
||||
(define (string-reverse x)
|
||||
(list->string (reverse (string->list x))))
|
||||
|
||||
;; makes a memoization wrapper around a function
|
||||
(define (memoize func)
|
||||
(define memo (make-hash))
|
||||
(lambda args
|
||||
(hash-ref! memo args (λ () (apply func args)))))
|
||||
|
||||
(define-syntax-parse-rule (define/memoized (name:id arg:id ...) body:expr ...+)
|
||||
(define name (memoize (λ (arg ...) body ...))))
|
||||
|
||||
(define-syntax-parse-rule (define/memo (name:id arg:id ...) body:expr ...+)
|
||||
(define name (memoize (λ (arg ...) body ...))))
|
||||
|
||||
;; helper for maximum-bipartite-matching
|
||||
;; given an edge list where each first item corresponds to the left set and each second item
|
||||
;; corresponds to the right set, return a matching list where the first item is from the left set
|
||||
;; and the second item is from the right
|
||||
(define (maximum-bipartite-matching/stable edges)
|
||||
(when (empty? edges) (error "provided empty edges list"))
|
||||
(define left (list->set (map first edges)))
|
||||
(define G (undirected-graph edges))
|
||||
(define matching (maximum-bipartite-matching G))
|
||||
(define num-first-lefts
|
||||
(for/sum ([m (in-list matching)] #:when (set-member? left (first m)))
|
||||
1))
|
||||
;; if the first set contains more elements belonging to lefts than rights, then assume it's in
|
||||
;; the right order. otherwise, swap
|
||||
(if (> num-first-lefts (- (length matching) num-first-lefts))
|
||||
matching
|
||||
(map #{list (second %) (first %)} matching)))
|
||||
|
||||
;; submit a solution to the server if not already submitted
|
||||
(define (answer day part answer)
|
||||
(printf "answer ~a.~a: ~s\n" day part answer)
|
||||
(unless (aoc-complete? day part)
|
||||
(printf "submit? [Y/n]: ")
|
||||
(match (string-downcase (string-trim (read-line)))
|
||||
[(or "" "y" "yes")
|
||||
(printf "submitting...\n")
|
||||
(define resp
|
||||
(aoc-submit-answer (getenv "AOC_YEAR") (~a day) (getenv "AOC_SESSION") (~a part)
|
||||
(~a answer)))
|
||||
(printf "server responded: ~a\n" resp)]
|
||||
[_ (printf "not submitting\n")])))
|
||||
|
||||
;; submit 25 part 2
|
||||
(define (aoc-finish)
|
||||
(unless (aoc-complete? 25 1)
|
||||
(error "submit 25.1 first"))
|
||||
(unless (aoc-complete? 25 2)
|
||||
(printf "submitting done for 25.2...\n")
|
||||
(define resp
|
||||
(aoc-submit-answer (getenv "AOC_YEAR") "25" (getenv "AOC_SESSION") "2" "done"))
|
||||
(printf "server responded: ~a\n" resp)))
|
||||
|
|
@ -0,0 +1,91 @@
|
|||
#!/usr/bin/env racket
|
||||
#lang racket
|
||||
|
||||
(require html xml "ansi-color.rkt" "aoc-lib.rkt")
|
||||
|
||||
;; finds a given element of an xexpr
|
||||
(define (find-element el doc)
|
||||
(match doc
|
||||
[(list (== el) _ ...) doc]
|
||||
[(list tag attrs children ...)
|
||||
(ormap (curry find-element el) children)]
|
||||
[_ #f]))
|
||||
|
||||
(struct style-ast [fg bg fs children] #:transparent)
|
||||
;; convert xexpr tree to an ast with lower-level styling
|
||||
(define (xexpr->style-ast doc)
|
||||
(match doc
|
||||
[(? string?) (style-ast #f #f #f doc)]
|
||||
[(list (or 'script 'form) _ ...) #f]
|
||||
[(list-no-order 'p (list 'span (list-no-order '(class "share")) _ ...) _ ...) #f]
|
||||
[(list 'li _ children ...)
|
||||
(define out-children (filter identity (map xexpr->style-ast children)))
|
||||
(style-ast #f #f #f (cons (style-ast #f #f #f "- ") out-children))]
|
||||
[(list tag attrs children ...)
|
||||
(define-values [fg bg fs]
|
||||
(match* (tag attrs)
|
||||
[('main _) (values #f #f #f)]
|
||||
[('article _) (values #f #f #f)]
|
||||
[('p (list-no-order '(class "day-success") _ ...)) (values 'yellow #f 'bold)]
|
||||
[('p _) (values #f #f #f)]
|
||||
[('pre _) (values #f #f #f)]
|
||||
[('h2 _) (values #f #f 'bold)]
|
||||
[('ul _) (values #f #f #f)]
|
||||
[('a _) (values 'green #f #f)]
|
||||
[('code _) (values 'white 234 #f)]
|
||||
[('span _) (values #f #f #f)]
|
||||
[('em (list-no-order '(class "star") _ ...)) (values 'yellow #f 'bold)]
|
||||
[('em _) (values #f #f 'bold)]
|
||||
[(_ _)
|
||||
(printf "warning: unhandled ~a ~a\n" tag attrs)
|
||||
(values #f #f #f)]))
|
||||
(define inner-children (filter identity (map xexpr->style-ast children)))
|
||||
(define new-children
|
||||
(if ((or/c 'h2 'pre 'p) tag)
|
||||
(let ([nls (list (style-ast #f #f #f "\n") (style-ast #f #f #f "\n"))])
|
||||
(append nls inner-children nls))
|
||||
inner-children))
|
||||
(style-ast fg bg fs new-children)]))
|
||||
|
||||
|
||||
(define (output-style-ast ast)
|
||||
(define num-newlines (make-parameter #f))
|
||||
|
||||
(define (helper ast [prev-bg ""] [prev-fg ""] [prev-fs ""])
|
||||
(match-define (style-ast fg bg fs children) ast)
|
||||
(when bg (background-color bg))
|
||||
(when fg (foreground-color fg))
|
||||
(when fs (font-style fs))
|
||||
(match children
|
||||
["\n"
|
||||
(unless (or (false? (num-newlines)) (>= (num-newlines) 2))
|
||||
(num-newlines (add1 (num-newlines)))
|
||||
(display "\n"))]
|
||||
[(? string? str)
|
||||
(num-newlines 0)
|
||||
(if (string-contains? str "\n")
|
||||
(for ([i (in-naturals)] [line (in-list (string-split (string-trim str "\n") "\n"))])
|
||||
(color-display (format (if (zero? i) "~a~a" "\n~a~a") erase-line line)))
|
||||
(color-display str))]
|
||||
[_ (map (lambda (item) (helper item (or bg prev-bg) (or fg prev-fg) (or fs prev-fs)))
|
||||
children)])
|
||||
(when prev-bg (background-color prev-bg))
|
||||
(when prev-fg (foreground-color prev-fg))
|
||||
(when prev-fs (font-style prev-fs)))
|
||||
|
||||
(num-newlines #f)
|
||||
(helper ast))
|
||||
|
||||
(command-line
|
||||
#:program "get-challenge"
|
||||
#:args (day)
|
||||
(define in (aoc-fetch-challenge (getenv "AOC_YEAR") day (getenv "AOC_SESSION")))
|
||||
(use-html-spec #f)
|
||||
(define doc-xmls (read-html-as-xml in))
|
||||
(close-input-port in)
|
||||
(define doc `(top-element ,@(map xml->xexpr doc-xmls)))
|
||||
|
||||
(define main (find-element 'main doc))
|
||||
(define ast (xexpr->style-ast main))
|
||||
; (pretty-write ast)
|
||||
(output-style-ast ast))
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
#!/usr/bin/env racket
|
||||
#lang racket
|
||||
|
||||
(require "aoc-lib.rkt")
|
||||
|
||||
(command-line
|
||||
#:program "get-input"
|
||||
#:args (day)
|
||||
(define in (aoc-fetch-input (getenv "AOC_YEAR") day (getenv "AOC_SESSION")))
|
||||
(call-with-output-file (build-path "inputs" day) (lambda (out) (copy-port in out))))
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
#!/usr/bin/env racket
|
||||
#lang racket
|
||||
|
||||
(require racket/runtime-path
|
||||
scribble/text (rename-in scribble/text/output [output scribble-output])
|
||||
"aoc-lib.rkt")
|
||||
|
||||
(define-runtime-path template "template.rktrkt")
|
||||
|
||||
(define (eval-template file vars [port (current-output-port)])
|
||||
(define cs (current-namespace))
|
||||
(define output-exp
|
||||
(parameterize ([current-namespace (make-base-namespace)])
|
||||
(for ([mod (in-list '(scribble/text))])
|
||||
(namespace-attach-module cs mod)
|
||||
(namespace-require mod))
|
||||
(hash-for-each vars namespace-set-variable-value!)
|
||||
(eval `(include/text (file ,file)))))
|
||||
(scribble-output output-exp port))
|
||||
|
||||
(command-line
|
||||
#:program "make-day"
|
||||
#:args (day)
|
||||
;; make solution file
|
||||
(call-with-output-file
|
||||
(format "~a.rkt" day)
|
||||
(lambda (out)
|
||||
(eval-template (path->string template) (hash 'day day) out))))
|
||||
|
|
@ -0,0 +1,102 @@
|
|||
#!/usr/bin/env racket
|
||||
#lang racket
|
||||
|
||||
(require "aoc-lib.rkt" plot/no-gui)
|
||||
(provide make-plot)
|
||||
|
||||
(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 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)]
|
||||
[(? 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)])
|
||||
(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 (get-last-pts m-tl))
|
||||
(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))
|
||||
(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"))
|
||||
|
||||
(module+ main
|
||||
(require plot)
|
||||
(plot-new-window? #t)
|
||||
(make-plot plot))
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
html, body { background: #111; color: #dde; font-family: monospace; font-size: 1.05rem; }
|
||||
|
||||
h1, h2, h3, p { font-family: monospace; }
|
||||
|
||||
.tocset { display: none; }
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
#lang scribble/base
|
||||
|
||||
@(require plot/no-gui racket racket/date "plot")
|
||||
@(date-display-format 'iso-8601)
|
||||
@(define now (current-date))
|
||||
|
||||
@title[#:style '(toc-hidden no-sidebar no-index no-toc+aux)]{BLÅHAJ score chart}
|
||||
|
||||
meow
|
||||
|
||||
last updated: @(date->string now #t)
|
||||
|
||||
@(parameterize ([plot-width 2048] [plot-height 1024])
|
||||
(make-plot plot-pict))
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
#!/usr/bin/env racket
|
||||
#lang racket
|
||||
|
||||
(require "aoc-lib.rkt")
|
||||
|
||||
(command-line
|
||||
#:program "submit-answer"
|
||||
#:args (day part answer)
|
||||
(define resp (aoc-submit-answer (getenv "AOC_YEAR") day (getenv "AOC_SESSION") part answer))
|
||||
(printf "server returned: ~a\n" resp))
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
#lang curly-fn racket
|
||||
|
||||
(require "scripts/aoc.rkt")
|
||||
|
||||
;; solution for day @day
|
||||
|
||||
(define (part1 input)
|
||||
;; ...
|
||||
(void))
|
||||
|
||||
@(if (equal? day "25") "" "(define (part2 input)
|
||||
;; ...
|
||||
(void))
|
||||
")
|
||||
(define (parse fname)
|
||||
(define input (file->lines fname))
|
||||
(void input))
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
(displayln "no tests :("))
|
||||
|
||||
(module+ main
|
||||
(define input (parse "inputs/@day"))
|
||||
(answer @day 1 (time (part1 input)))
|
||||
@(if (equal? day "25") "(aoc-finish)" (string-append "(answer " day " 2 (time (part2 input)))"))
|
||||
(displayln "meow"))
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
#!/usr/bin/env racket
|
||||
#lang racket
|
||||
|
||||
(require racket/rerequire racket/runtime-path)
|
||||
|
||||
(define (reinvoke file)
|
||||
(displayln "invoking module")
|
||||
(define p (build-path file))
|
||||
(dynamic-rerequire p)
|
||||
(dynamic-require (list 'submod p 'main) #f)
|
||||
(displayln "invocation complete"))
|
||||
|
||||
(define (watch-forever file)
|
||||
(sleep 0.2)
|
||||
(match (filesystem-change-evt file (λ () #f))
|
||||
[#f
|
||||
(displayln "error watching file...")
|
||||
(sleep 1)]
|
||||
[chg-evt
|
||||
(define runner (thread (lambda () (reinvoke file))))
|
||||
|
||||
(define (handle-break _)
|
||||
(cond
|
||||
[(sync/timeout 0 runner)
|
||||
(displayln "exiting")
|
||||
(exit)]
|
||||
[else
|
||||
(displayln "killing module")
|
||||
(kill-thread runner)
|
||||
(filesystem-change-evt-cancel chg-evt)]))
|
||||
|
||||
(with-handlers ([exn:break? handle-break])
|
||||
(sync chg-evt)
|
||||
(kill-thread runner))])
|
||||
(watch-forever file))
|
||||
|
||||
(define-runtime-path aoc "aoc.rkt")
|
||||
(command-line
|
||||
#:program "watch"
|
||||
#:args (day)
|
||||
(displayln "warming up")
|
||||
(dynamic-require aoc #f)
|
||||
(displayln "ready to go!")
|
||||
(watch-forever (format "~a.rkt" day)))
|
||||
Loading…
Reference in New Issue