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