Now that I have a couple years experience with Advent of Code, I'd like to get a little more organized prior to the contest. I'm hoping to create a blog post for most of the days, and I think I'll make use of Ryan Culpepper's IRacket package this year. IRacket allows creating Jupyter notebooks, and by exporting them as markdown files, they can be copy/pasted directly into a Frog static site generator file for a blog post. I thought about using only a notebook this year, but I think I would miss having a clutter-free version of just the code.
Last year's support code
It's hard to anticipate what might be needed ahead of time, but here is some code I've used in past years. All of the support code is in the advent.rkt file. The actual code is fully commented, and most of the functions have contracts describing their type signatures, but I'll strip that out for this post for brevity reasons, and supply example invocations for each function instead:
#lang iracket/lang #:require racket ; The IRacket notebook way of stating: #lang racket
(require racket/generator
threading)
point
(struct point (x y z) #:transparent)
(define (point-add p1 p2)
(point (+ (point-x p1) (point-x p2))
(+ (point-y p1) (point-y p2))
(+ (point-z p1) (point-z p2))))
(point 3 5 7)
(define (point-sub p1 p2)
(point (- (point-x p1) (point-x p2))
(- (point-y p1) (point-y p2))
(- (point-z p1) (point-z p2))))
(point -1 8 3)
pair-stream
(define-struct pair-stream (v)
#:methods gen:stream
[(define (stream-empty? stream)
(empty? (pair-stream-v stream)))
(define (stream-first stream)
(let ([ pair (first (pair-stream-v stream)) ])
(values (car pair) (cdr pair))))
(define (stream-rest stream)
(pair-stream (rest (pair-stream-v stream))))])
40
ascending-permutations-generator
(define (ascending-permutations-generator n lst)
(generator ()
(let loop ([ lst lst ][ n n ][ stack '() ])
(if (= n 0)
(yield (reverse stack))
(if (null? lst)
#f
(begin
(loop (cdr lst) (sub1 n) (cons (car lst) stack))
(loop (cdr lst) n stack)))))))
'(1 2 3)
'(1 2 4)
'(3 4 5)
bool-list->decimal
(define (bool-list->decimal lst)
(let loop ([lst lst] [acc 0])
(match lst [ '() acc ]
[ (cons 0 _) (loop (cdr lst) (* 2 acc)) ]
[ (cons 1 _) (loop (cdr lst) (+ (* 2 acc) 1)) ]
[ _ 0 ])))
5
bool-string-list->decimal
11
chunk
(define (chunk lst n)
(define (get-chunk lst n)
(let loop ([lst lst] [acc '()] [n n])
(if (or (null? lst) (< n 1))
(values (reverse acc) lst)
(loop (cdr lst) (cons (car lst) acc) (- n 1)))))
(let loop ([lst lst] [acc '()])
(if (null? lst)
(reverse acc)
(let-values ([(chunk rest) (get-chunk lst n)])
(loop rest (cons chunk acc))))))
'((1 2 3) (4 5 6) (7 8))
csv-file->numbers
;; Read a file consisting of one line of a comma delimited list of
;; numbers into a list of numbers.
(define (csv-file->numbers fname)
(~>> (file->string fname)
string-trim
(string-split _ ",")
(map string->number)))
;; no example invocation since we can't write to a file in a notebook
filter-ascending-permutations
(define (filter-ascending-permutations pred? n lst)
(reverse
(let loop ([ lst lst ][ n n ][ stack '() ][ result '() ])
(if (= n 0)
(let ([ s (reverse stack) ])
(if (pred? s) (cons s result) result))
(if (null? lst)
result
(loop (cdr lst)
n
stack
(loop (cdr lst) (sub1 n) (cons (car lst) stack) result)))))))
(let ([ sum-is-even? (λ (lst) (even? (foldl + 0 lst))) ])
(filter-ascending-permutations sum-is-even? 3 '(1 2 3 4 5)))
'((1 2 3) (1 2 5) (1 3 4) (1 4 5) (2 3 5) (3 4 5))
iterate
5
list-max
9
list-min
0
list-prod
120
list-sum
15
string-left
"1234"
string-right
"6789"
vector-sum
15
vector-update!
'#(1 2 4 4 5)
windows
(define (windows n lst)
(let ([ window (with-handlers ([ exn:fail:contract? (λ (_) #f) ])
(take lst n)) ])
(if window
(cons window (windows n (cdr lst)))
'())))
'((1 2 3) (2 3 4) (3 4 5) (4 5 6))
zipn
(define (zipn . args)
(let loop ([ lists args ][ result '() ])
(cond [ (ormap empty? lists) (reverse result) ]
[ else (loop (map rest lists) (cons (map first lists) result)) ])))
'((1 2 7) (2 3 8) (3 4 9))
Support code from others
Peter Norvig shared some support code from last year's contest for parsing the daily input and displaying sample output. I translated some useful bits into Racket. You'll see it in use on future blog posts for individual puzzles.
parse-aoc
;; (parse-aoc day parser sep print-lines) -> list?
;; day : positive-integer?
;; parser : (-> string? any/c)
;; sep : string?
;; print-lines : exact-nonnegative-integer?
;;
;; Translation of Peter Norvig's Advent of Code parse function.
;;
;; * Read the input file for <day>
;; * Print out the first few lines of the file to give an idea of the
;; file's contents
;; * Break the file into a sequence of entries separated by <sep>
;; * Apply <parser> to each entry and return the results as a list
;; - Example parser functions include:
;; numbers, digits, atoms, words, and built-ins such as:
;; string->number, identity
(define (parse-aoc day [parser identity] [sep "\n"] [print-lines 7])
;; Helper -----------------------------------------------------------------------------------
(define (print-sample fname text entries num-lines)
(let* ([ all-lines (string-split text "\n") ]
[ lines (take all-lines num-lines) ]
[ head (format "~a -> ~a chars, ~a lines; first ~a lines:"
fname
(string-length text)
(length all-lines)
(length lines)) ]
[ dash (make-string 100 #\-) ])
(printf "~a\n~a\n~a\n" dash head dash)
(for ([line (in-list lines) ])
(printf "~a\n" (trunc line)))
(printf "~a\n(parse ~a) -> ~a entries:\n" dash day (length entries))
(printf "~a\n~a\n~a" dash (trunc (format "~s" entries)) dash)))
(define (trunc s [left 70] [right 25] [dots " ... "])
(if (<= (string-length s)
(+ left right (string-length dots)))
s
(string-append (string-left s left)
dots
(string-right s right))))
;; ------------------------------------------------------------------------------------------
(let* ([ fname (format "day~a.txt" (~r day #:min-width 2 #:pad-string "0")) ]
[ text (file->string fname) ]
[ entries (map parser (~> text
string-trim
(string-split _ sep))) ])
(when (and print-lines (> print-lines 0))
(print-sample fname text entries print-lines))
entries))
Here are the individual parsers:
atom
(define (atom str)
(cond [ (regexp-match? #px"^-?[0-9]+(\\.[0-9]*)?$" str)
(string->number str) ]
[ else str ]))
-3.14
"a-symbol-name"
atoms
'("a-symbol" 3.14 -78 "foo")
digits
'(0 1 2 3 4 5 6 7 8 9 1 0)
numbers
'(12 3.14 56 123 67 78)
words
'("the" "cow" "jumped" "over" "the" "moon")
Tests for advent.rkt
(require rackunit)
;; ascending-permutations-generator ---------------------------------------------------------
(let ([ g (ascending-permutations-generator 3 '(1 2 3 4 5)) ])
(for ([ lst (in-list '((1 2 3) (1 2 4) (1 2 5) (1 3 4) (1 3 5)
(1 4 5) (2 3 4) (2 3 5) (2 4 5) (3 4 5))) ])
(check-equal? (g) lst)))
;; atom
(for ([ pair (in-list '(( "-3.14" -3.14)
( "-78" -78)
( "3.14" 3.14)
( "my-symbol" "my-symbol"))) ])
(check-equal? (atom (first pair)) (second pair)))
;; atoms
(check-equal? (atoms " a-symbol 3.14\n -78 foo")
'("a-symbol" 3.14 -78 "foo"))
;; bool-list->decimal ----------------------------------------------------------------
(for ([ pair (in-list '(((1 0 1 1) 11)
((0 0 0) 0)
((0 0 1) 1)
((0 1 0) 2)
((0 1 1) 3)
((1 0 0) 4)
((1 1 1) 7))) ])
(check-equal? (bool-list->decimal (first pair)) (second pair)))
;; bool-string-list->decimal ----------------------------------------------------------------
(check-equal? (bool-string-list->decimal '("1" "0" "1" "1")) 11)
;; chunk ------------------------------------------------------------------------------------
(check-equal? (chunk (range 15) 5)
'((0 1 2 3 4)
(5 6 7 8 9)
(10 11 12 13 14)))
;; csv-file->numbers ------------------------------------------------------------------------
;; NOTE: notebook doesn't allow writing to file
#;(let ([ path (path->string (make-temporary-file)) ])
(dynamic-wind (λ ()
;; Create the cvs line
(with-output-to-file path
(λ ()
(printf "1,6,43,8,0,21,50\n"))
#:exists 'replace))
(λ ()
(check-equal? (csv-file->numbers path)
'(1 6 43 8 0 21 50)))
(λ ()
(delete-file path))))
;; digits
(check-equal? (digits "0123\n456\n78910")
'(0 1 2 3 4 5 6 7 8 9 1 0))
;; filter-ascending-permutations ------------------------------------------------------------
(let ([ sum-is-even? (λ (lst) (even? (foldl + 0 lst))) ])
(check-equal? (filter-ascending-permutations sum-is-even? 3 '(1 2 3 4 5))
'((1 2 3) (1 2 5) (1 3 4) (1 4 5) (2 3 5) (3 4 5))))
;; iterate
(let ([ fun (λ (n) (+ n 3)) ])
(check-equal? (iterate fun 7 4) 19))
(let ([ fun (λ (s)
(cond [ (symbol? s) (symbol->string s) ]
[ (string? s) (string->symbol s) ]
[ else (error "Invalid") ])) ])
(check-equal? (iterate fun 'foo 0) 'foo)
(check-equal? (iterate fun 'foo 1) "foo")
(check-equal? (iterate fun 'foo 2) 'foo)
(check-equal? (iterate fun 'foo 3) "foo"))
;; list-max
(check-equal? (list-max '(3 8 4 9 0 -3)) 9)
(check-equal? (list-max '(-3 -2 -9)) -2)
;; list-min
(check-equal? (list-min '(3 8 4 9 0)) 0)
(check-equal? (list-min '(3 8 4 9 0 -3)) -3)
(check-equal? (list-min '(-3 -2 -9)) -9)
;; list-prod
(check-equal? (list-prod '(2 7 4 13)) 728)
;; list-sum
(check-equal? (list-sum '(2 7 4 13)) 26)
;; numbers
(check-equal? (numbers "012,3.14,56\n123;67->78")
'(12 3.14 56 123 67 78))
;; point-add
(check-equal? (point-add (point 1 2 3)
(point 2 3 4))
(point 3 5 7))
;; point-sub
(check-equal? (point-sub (point 1 2 3)
(point 2 3 4))
(point -1 -1 -1))
;; vector-sum
(check-equal? (vector-sum #(2 7 4 13)) 26)
;; vector-update!
(let ([ vec (vector 1 2 3 4 5) ])
(vector-update! vec 2 add1)
(check-equal? vec #(1 2 4 4 5)))
;; words
(check-equal? (words "the,cow\njumped->over\nthe -> moon")
'("the" "cow" "jumped" "over" "the" "moon"))
;; zipn
(check-equal? (zipn '(1 2 3 4 5) '(2 3 4 5) '(3 4 5))
'((1 2 3) (2 3 4) (3 4 5)))
;; pair-stream ------------------------------------------------------------------------------
(check-equal?
(for/sum ([ (a b) (in-stream (pair-stream '((1 . 2) (2 . 3) (3 . 4) (4 . 5)))) ])
(* a b))
40)