pull/1/merge
Benjamin Greenman 8 years ago committed by GitHub
commit 003fc70c2a

@ -1,6 +1,6 @@
#lang info
(define collection "aoc-racket")
(define scribblings '(("aoc-racket.scrbl" (multi-page))))
(define deps '("base" "scribble-lib" "sugar" "rackunit-lib" "math-lib"))
(define deps '("base" "scribble-lib" "sugar" "rackunit-lib" "math-lib" "typed-racket-lib" "typed-racket-more" "trivial"))
(define test-omit-paths (list #rx"rkt$"))
(define build-deps '("rackunit-lib" "racket-doc" "scribble-doc" "rackunit-doc" "at-exp-lib" "math-doc"))
(define build-deps '("rackunit-lib" "racket-doc" "scribble-doc" "rackunit-doc" "at-exp-lib" "math-doc"))

@ -0,0 +1,77 @@
#lang typed/racket
(require typed/rackunit)
(provide (all-defined-out))
(define up-char #\()
(define down-char #\))
(: make-matcher (-> Char (-> String Natural)))
(define (make-matcher c)
(λ((str : String)) (length (regexp-match* (regexp (format "\\~a" c)) str))))
(define get-ups (make-matcher up-char))
(define get-downs (make-matcher down-char))
(: get-destination (-> String Integer))
(define (get-destination str) (- (get-ups str) (get-downs str)))
(: q1 (-> String Integer))
(define (q1 str)
(get-destination str))
(: elevator-string->ints (-> String (Listof Integer)))
(define (elevator-string->ints str)
(for/list : (Listof Integer)
([c (in-string str)])
(if (equal? c up-char)
1
-1)))
(: q1-alt (-> String Integer))
(define (q1-alt str)
(apply + (elevator-string->ints str)))
(: in-basement? (-> (Listof Integer) Boolean))
(define (in-basement? movements)
(negative? (apply + movements)))
(: q2 (-> String Integer))
(define (q2 str)
(define relative-movements
(for/fold : (Listof Integer)
([movements-so-far : (Listof Integer) empty])
([c (in-string str)]
;#:break (in-basement? movements-so-far)
)
(if (in-basement? movements-so-far)
movements-so-far
(cons (get-destination (~a c)) movements-so-far))))
(length relative-movements))
(: q2-for/first (-> String (U #f Integer)))
(define (q2-for/first str)
(define basement-position
(let ([ints (elevator-string->ints str)])
(for/or : (U #f Integer) ;;bg first=>or
([idx (in-range (length ints))]
#:when (negative? (apply + (take ints idx))))
idx)))
basement-position)
(: q2-for/or (-> String (U #f Integer)))
(define (q2-for/or str)
(define basement-position
(let ([ints (elevator-string->ints str)])
(for/or : (U #f Integer)
([idx (in-range (length ints))])
(and (negative? (apply + (take ints idx))) idx))))
basement-position)
(module+ test
(define input-str (file->string "../day01-input.txt"))
(check-equal? (q1 input-str) 74)
(check-equal? (q1-alt input-str) 74)
(check-equal? (q2 input-str) 1795)
(check-equal? (q2-for/first input-str) 1795)
(check-equal? (q2-for/or input-str) 1795))

@ -0,0 +1,41 @@
#lang typed/racket
(require typed/rackunit)
(provide (all-defined-out))
(define-type Box (List Natural Natural Natural))
(: string->boxes (-> String (Listof Box)))
(define (string->boxes str)
(for/list : (Listof Box)
([ln (in-list (string-split str "\n"))])
(cast (map string->number (string-split ln "x")) Box)))
(: box->paper (-> Box Natural))
(define (box->paper box)
(match-define (list x y z) box)
(define sides (list (* x y) (* y z) (* x z)))
(+ (* 2 (apply + sides)) (apply min sides)))
(: q1 (-> String Natural))
(define (q1 str)
(define boxes (string->boxes str))
(apply + (map box->paper boxes)))
(: box->ribbon (-> Box Natural))
(define (box->ribbon box)
(match-define (list x y z) box)
(: perimeter (-> Natural Natural Natural))
(define (perimeter dim1 dim2) (* 2 (+ dim1 dim2)))
(define perimeters
(list (perimeter x y) (perimeter y z) (perimeter x z)))
(+ (apply min perimeters) (* x y z)))
(: q2 (-> String Natural))
(define (q2 str)
(define boxes (string->boxes str))
(apply + (map box->ribbon boxes)))
(module+ test
(define input-str (file->string "../day02-input.txt"))
(check-equal? (q1 input-str) 1586300)
(check-equal? (q2 input-str) 3737498))

@ -0,0 +1,76 @@
#lang typed/racket
(require typed/rackunit)
(provide (all-defined-out))
(define-type Move (List Integer Integer))
(define-type Cell (List Integer Integer))
(: string->cells (-> String (Listof Cell)))
(define (string->cells str)
(define start '(0 0))
(match-define (list east north west south) '((1 0) (0 1) (-1 0) (0 -1)))
(define moves (for/list : (Listof Move)
([c (in-string str)])
(case c
[(#\>) east]
[(#\^) north]
[(#\<) west]
[(#\v) south]
[else (error 'TR)])))
(for/fold : (Listof Cell)
([cells-so-far : (Listof Cell) (list start)])
([next-move (in-list moves)])
(define current-cell (car cells-so-far))
(define next-cell (map + current-cell next-move))
(cons (cast next-cell Cell) cells-so-far)))
(: q1 (-> String Integer))
(define (q1 str)
(length (remove-duplicates (string->cells str))))
(: string->complex-cells (-> String (Listof Complex)))
(define (string->complex-cells str)
(define start 0)
(define east 1)
(define moves (for/list : (Listof Complex)
([c (in-string str)])
(* east (expt +i (case c
[(#\>) 0]
[(#\^) 1]
[(#\<) 2]
[(#\v) 3]
[else (error 'TR)])))))
(for/fold : (Listof Complex)
([cells-so-far : (Listof Complex) (list start)])
([next-move (in-list moves)])
(define current-cell (car cells-so-far))
(define next-cell (+ current-cell next-move))
(cons next-cell cells-so-far)))
(: q1-complex (-> String Natural))
(define (q1-complex str)
(length (remove-duplicates (string->complex-cells str))))
(: split-odds-and-evens (-> String (Values String String)))
(define (split-odds-and-evens str)
(define-values (odd-chars even-chars)
(for/fold : (Values (Listof Char) (Listof Char))
([odds-so-far : (Listof Char) empty][evens-so-far : (Listof Char) empty])
([c (in-string str)][i (in-naturals)])
(if (even? i)
(values odds-so-far (cons c evens-so-far))
(values (cons c odds-so-far) evens-so-far))))
(values (string-append* (map string (reverse odd-chars)))
(string-append* (map string (reverse even-chars)))))
(: q2 (-> String Integer))
(define (q2 str)
(define-values (odd-str even-str) (split-odds-and-evens str))
(length (remove-duplicates
(append (string->cells odd-str) (string->cells even-str)))))
(module+ test
(define input-str (file->string "../day03-input.txt"))
(check-equal? (q1 input-str) 2565)
(check-equal? (q1-complex input-str) 2565)
(check-equal? (q2 input-str) 2639))

@ -0,0 +1,22 @@
#lang typed/racket
(require typed/rackunit typed/openssl/md5)
(provide (all-defined-out))
(: q1 (-> String (U #f Natural)))
(define (q1 str)
(for/or : (U #f Natural) ([i : Natural (in-naturals)])
(define md5-key (string-append str (~a i)))
(define md5-hash (md5 (open-input-string md5-key)))
(and (string-prefix? md5-hash "00000") i)))
(: q2 (-> String (U #f Natural)))
(define (q2 str)
(for/or : (U #f Natural) ([i : Natural (in-naturals)])
(define md5-key (string-append str (~a i)))
(define md5-hash (md5 (open-input-string md5-key)))
(and (string-prefix? md5-hash "000000") i)))
(module+ test
(define input-str (file->string "../day04-input.txt"))
(check-equal? (q1 input-str) 346386)
(check-equal? (q2 input-str) 9958218))

@ -0,0 +1,37 @@
#lang typed/racket
(require typed/rackunit)
(provide (all-defined-out))
(: nice? (-> String Boolean))
(define (nice? str)
(define (three-vowels? (str : String))
(>= (length (regexp-match* #rx"[aeiou]" str)) 3))
(define (double-letter? (str : String))
(regexp-match #px"(.)\\1" str))
(define (no-kapu? (str : String))
(not (regexp-match #rx"ab|cd|pq|xy" str)))
(and (three-vowels? str)
(double-letter? str)
(no-kapu? str)))
(: q1 (-> (Listof String) Natural))
(define (q1 words)
(length (filter nice? words)))
(: nicer? (-> String Boolean))
(define (nicer? str)
(define (nonoverlapping-pair? (str : String))
(regexp-match #px"(..).*\\1" str))
(define (separated-repeater? (str : String))
(regexp-match #px"(.).\\1" str))
(and (nonoverlapping-pair? str)
(separated-repeater? str) #t))
(: q2 (-> (Listof String) Natural))
(define (q2 words)
(length (filter nicer? words)))
(module+ test
(define input-str (file->lines "../day05-input.txt"))
(check-equal? (q1 input-str) 238)
(check-equal? (q2 input-str) 69))

@ -0,0 +1,99 @@
#lang typed/racket
(require typed/rackunit trivial/regexp/no-colon)
(provide (all-defined-out))
(: string->natural (-> String Natural))
(define (string->natural str)
(cast (string->number str) Natural))
(: str->instruction (-> String (Pairof (-> Natural Natural) (Listof Natural))))
(define (str->instruction str)
(match-define (list* _ action coordinates)
(regexp-match #px"^(.*?)(\\d+),(\\d+) through (\\d+),(\\d+)$" str))
(: action->bulb-func (-> String (-> Natural Natural)))
(define (action->bulb-func action)
(case action
[("turn on") (λ([bulb : Natural]) 1)] ;;bg : 2016-07-25 TR cannot use thunk*
[("turn off") (λ([bulb : Natural]) 0)]
[else (λ([bulb : Natural]) (if (= bulb 1) 0 1))]))
(list* (action->bulb-func (string-trim action))
(map string->natural coordinates)))
(: q1 (-> (Listof String) Natural))
(define (q1 strs)
(define lights : (Vectorof Natural) (make-vector (* 1000 1000) 0))
(for ([instruction (in-list (map str->instruction strs))])
(set-lights lights instruction))
(count-lights lights))
(: set-lights (-> (Vectorof Natural) (Pairof (-> Natural Natural) (Listof Natural)) Void))
(define (set-lights lights arglist)
(match-define (list bulb-func x1 y1 x2 y2) arglist)
(for* ([x (in-range x1 (add1 x2))][y (in-range y1 (add1 y2))])
(define vector-loc (+ (* 1000 x) y))
(define current-light (vector-ref lights vector-loc))
(vector-set! lights vector-loc (bulb-func current-light))))
(: count-lights (-> (Vectorof Natural) Natural))
(define (count-lights lights)
(for/sum : Natural ([light (in-vector lights)]
#:when (positive? light))
light))
(: str->instruction-2 (-> String (Pairof (-> Natural Natural) (Listof Natural))))
(define (str->instruction-2 str)
(match-define (list* _ action coordinates)
(regexp-match #px"^(.*?)(\\d+),(\\d+) through (\\d+),(\\d+)$" str))
(: action->bulb-func (-> String (-> Natural Natural)))
(define (action->bulb-func action)
(case action
[("turn on") (λ([bulb : Natural]) (add1 bulb))]
[("turn off") (λ([bulb : Natural]) (max 0 (sub1 bulb)))]
[else (λ([bulb : Natural]) (+ bulb 2))]))
(list* (action->bulb-func (string-trim action))
(map string->natural coordinates)))
(: q2 (-> (Listof String) Natural))
(define (q2 strs)
(define lights : (Vectorof Natural) (make-vector (* 1000 1000) 0))
(for ([instruction (in-list (map str->instruction-2 strs))])
(set-lights lights instruction))
(count-lights lights))
(: day06-solve (-> (Listof String) (-> String (-> Natural Natural)) Natural))
(define (day06-solve strs bulb-func-converter)
(define lights : (Vectorof Natural) (make-vector (* 1000 1000) 0))
(for ([instruction (in-list (map (make-str-converter bulb-func-converter) strs))])
(set-lights lights instruction))
(count-lights lights))
(: make-str-converter (-> (-> String (-> Natural Natural)) (-> String (Pairof (-> Natural Natural) (Listof Natural)))))
(define (make-str-converter bulb-func-converter)
(λ ([str : String])
(match-define (list* _ action coordinates)
(regexp-match #px"^(.*?)(\\d+),(\\d+) through (\\d+),(\\d+)$" str))
(list* (bulb-func-converter (string-trim action))
(map string->natural coordinates))))
(: q1-bulb-func-converter (-> String (-> Natural Natural)))
(define q1-bulb-func-converter
(λ([action : String]) (case action
[("turn on") (λ([bulb : Natural]) 1)]
[("turn off") (λ([bulb : Natural]) 0)]
[else (λ([bulb : Natural]) (if (= bulb 1) 0 1))])))
(: q2-bulb-func-converter (-> String (-> Natural Natural)))
(define q2-bulb-func-converter
(λ([action : String]) (case action
[("turn on") (λ([bulb : Natural]) (add1 bulb))]
[("turn off") (λ([bulb : Natural]) (max 0 (sub1 bulb)))]
[else (λ([bulb : Natural]) (+ bulb 2))])))
(module+ test
(define input-strs (file->lines "../day06-input.txt"))
(check-equal? (q1 input-strs) 400410)
(check-equal? (q2 input-strs) 15343601)
(check-equal? (day06-solve input-strs q1-bulb-func-converter) 400410)
(check-equal? (day06-solve input-strs q2-bulb-func-converter) 15343601))

@ -0,0 +1,73 @@
#lang typed/racket
(require typed/rackunit
(for-syntax racket/file racket/string))
(provide (all-defined-out))
(define-syntax (convert-input-to-wire-functions stx)
(syntax-case stx ()
[(_)
(let* ([input-strings (file->lines "../day07-input.txt")]
[wire-strings (map (λ(str) (format "(wire ~a)" str)) input-strings)]
[wire-datums (map (compose1 read open-input-string) wire-strings)])
(datum->syntax stx `(begin ,@wire-datums)))]))
(define-syntax (wire stx)
(syntax-case stx (->)
[(_ arg -> wire-name)
#'(define (wire-name) : Integer (evaluate-arg arg))]
[(_ 16bit-op arg -> wire-name)
#'(define (wire-name) : Integer (16bit-op (evaluate-arg arg)))]
[(_ arg1 16bit-op arg2 -> wire-name)
#'(define (wire-name) : Integer (16bit-op (evaluate-arg arg1) (evaluate-arg arg2)))]
[(_ expr) #'(begin expr)]
[else #'(void)]))
(convert-input-to-wire-functions)
(define-type Wire-Cache (HashTable (-> Integer) Integer))
(: wire-value-cache Wire-Cache)
(define wire-value-cache (make-hash))
(: evaluate-arg (-> (U Integer (-> Integer)) Integer))
(define (evaluate-arg x)
(cond
[(procedure? x) (hash-ref! wire-value-cache x x)]
[else x]))
(: 16bitize (-> Integer Integer))
(define (16bitize x)
(define 16bit-max (expt 2 16))
(define r (modulo x 16bit-max))
(cond
[(negative? r) (16bitize (+ 16bit-max r))]
[else r]))
;;bg: edits
(define-syntax-rule (define-16bit id [dom ...] proc)
(define (id [dom : Integer] ...) : Integer (16bitize (proc dom ...))))
;;bg: added arity decl
(define-16bit AND [x y] bitwise-and)
(define-16bit OR [x y] bitwise-ior)
(define-16bit LSHIFT [x y] arithmetic-shift)
(define-16bit RSHIFT [x y] (λ ([x : Integer] [y : Integer]) (arithmetic-shift x (- y))))
(define-16bit NOT [x] bitwise-not)
(: q1 (-> Integer))
(define (q1) (a))
(compile-enforce-module-constants #f)
(: q2 (-> Integer))
(define (q2)
(define first-a-val (a))
(set! b (λ () first-a-val))
(set! wire-value-cache (ann (make-hash) Wire-Cache))
(a))
(module+ test
(check-equal? (q1) 46065)
(check-equal? (q2) 14134))

@ -0,0 +1,26 @@
#lang typed/racket
(require typed/rackunit)
(provide (all-defined-out))
(: memory-length (-> String Natural))
(define (memory-length str)
(string-length (cast (read (open-input-string str)) String)))
(: q1 (-> (Listof String) Integer))
(define (q1 strs)
(- (apply + (map string-length strs)) (apply + (map memory-length strs))))
(: encoded-length (-> String Natural))
(define (encoded-length str)
(string-length (~v str)))
(: q2 (-> (Listof String) Integer))
(define (q2 strs)
(- (apply + (map encoded-length strs)) (apply + (map string-length strs))))
(module+ test
(define input-strs (file->lines "../day08-input.txt"))
(check-equal? (q1 input-strs) 1333)
(check-equal? (q2 input-strs) 2046))

@ -0,0 +1,57 @@
#lang typed/racket
(require typed/rackunit trivial/regexp/no-colon trivial/list/no-colon)
(provide (all-defined-out))
(: distances (HashTable (List String String) Integer))
(define distances (make-hash))
(: str->hash (-> String Void))
(define (str->hash ln)
(match-define (list _ here there dist)
(regexp-match #px"^(\\w+) to (\\w+) = (\\d+)" ln))
(define key (places->key here there))
(hash-set! distances key (cast (string->number dist) Natural)))
(: places->key (-> String String (List String String)))
(define (places->key here there)
(define x (sort (list (string-downcase here) (string-downcase there)) string<?))
(list (car x) (cadr x)))
(: inf Integer)
(define inf 999999999999999999999)
(: calculate-route-distances (-> (Listof Integer)))
(define (calculate-route-distances)
(: pairify (-> (Listof String) (Listof (List String String))))
(define (pairify xs)
;;bg: replaced map with for/list
(for/list ([left (in-list (drop-right xs 1))]
[right (in-list (drop xs 1))])
: (Listof (List String String))
(list left right)))
(: distance (-> String String Integer))
(define (distance here there)
(hash-ref distances (places->key here there) (λ () inf)))
(define cities (remove-duplicates (append* (hash-keys distances))))
(for/list ([route (in-permutations cities)])
(for/sum ([pair (in-list (pairify route))])
: Integer
(apply distance pair))))
(: q1 (-> (Listof String) Integer))
(define (q1 strs)
(for-each str->hash strs)
(apply min (calculate-route-distances)))
(: q2 (-> (Listof String) Integer))
(define (q2 strs)
(apply max (calculate-route-distances)))
(module+ test
(define input-strs (file->lines "../day09-input.txt"))
(check-equal? (q1 input-strs) 251)
(check-equal? (q2 input-strs) 898))

@ -0,0 +1,32 @@
#lang typed/racket
(require typed/rackunit)
(provide (all-defined-out))
(: look-and-say (-> Natural String String))
(define (look-and-say iterations input-key)
(for/fold : String
([start input-key])
([i (in-range iterations)])
(define digit-runs (regexp-match* #px"(\\d)\\1*" start))
(string-append*
(map (ann ~a (-> Any String))
(append-map (λ([digit-run : String])
(list (string-length digit-run)
(substring digit-run 0 1)))
digit-runs)))))
(: q1 (-> String Natural))
(define (q1 input-key)
(string-length (look-and-say 40 input-key)))
(: q2 (-> String Natural))
(define (q2 input-key)
(string-length (look-and-say 50 input-key)))
(module+ test
(define input-key (file->string "../day10-input.txt"))
(check-equal? (q1 input-key) 492982)
(check-equal? (q2 input-key) 6989950))

@ -0,0 +1,56 @@
#lang typed/racket
(require typed/rackunit trivial/regexp/no-colon)
(provide (all-defined-out))
(: increment-password (-> String String))
(define (increment-password password)
(: increment-letter (-> String String))
(define (increment-letter c)
(~a (integer->char (add1 (char->integer (car (string->list c)))))))
;bg;((compose1 ~a integer->char add1 char->integer car string->list) c)
(match-define (list _ prefix letter-to-increment trailing-zs)
(regexp-match #rx"^(.*?)(.)(z*)$" password))
(string-append* (list prefix (increment-letter letter-to-increment)
(regexp-replace* #rx"z" trailing-zs "a"))))
(: three-consecutive-letters? (-> String Boolean))
(define (three-consecutive-letters? str)
(define ints (map char->integer (string->list str)))
(let loop : Boolean ([differences (map - (cdr ints) (drop-right ints 1))])
(if (empty? differences)
#f
(or (list-prefix? '(1 1) differences) (loop (cdr differences))))))
(: no-iol? (-> String Boolean))
(define (no-iol? str)
(not (regexp-match #rx"[iol]" str)))
(: two-nonoverlapping-doubles? (-> String Boolean))
(define (two-nonoverlapping-doubles? str)
(regexp-match? #px"(\\w)\\1.*?(\\w)\\2" str)) ;;bg: add ?
(: valid? (-> String Boolean))
(define (valid? password)
(and (three-consecutive-letters? password)
(no-iol? password)
(two-nonoverlapping-doubles? password)))
(: find-next-valid-password (-> String String))
(define (find-next-valid-password starting-password)
(define candidate-pw (increment-password starting-password))
(if (valid? candidate-pw)
candidate-pw
(find-next-valid-password candidate-pw)))
(: q1 (-> String String))
(define (q1 input-key)
(find-next-valid-password input-key))
(: q2 (-> String String))
(define (q2 input-key)
(find-next-valid-password (q1 input-key)))
(module+ test
(define input-key (file->string "../day11-input.txt"))
(check-equal? (q1 input-key) "hxbxxyzz")
(check-equal? (q2 input-key) "hxcaabcc"))

@ -0,0 +1,51 @@
#lang typed/racket
(require typed/rackunit typed/json)
(provide (all-defined-out))
(: string->jsexpr (-> String JSExpr))
(define (string->jsexpr str)
(define bg (read-json (open-input-string str)))
(if (eof-object? bg)
(error 'day12:eof)
bg))
(define-type JSTree JSExpr) ;(Rec T (U JSExpr (Listof T))))
(: flatten-jsexpr (-> JSExpr (Listof Any)))
(define (flatten-jsexpr jsexpr)
(flatten
(let loop : Any ([x : Any jsexpr])
(cond
[(list? x)
(map loop x)]
[(hash? x)
(loop (flatten (hash->list x)))]
[else x]))))
(: q1 (-> String Number))
(define (q1 input-str)
(define json-items (flatten-jsexpr (string->jsexpr input-str)))
(apply + (filter number? json-items)))
(: flatten-jsexpr-2 (-> JSExpr (Listof Any)))
(define (flatten-jsexpr-2 jsexpr)
(flatten
(let loop : Any ([x : Any jsexpr])
(cond
[(list? x)
(map loop x)]
[(hash? x)
(if (member "red" (hash-values x))
empty
(loop (flatten (hash->list x))))]
[else x]))))
(: q2 (-> String Number))
(define (q2 input-str)
(define json-items (flatten-jsexpr-2 (string->jsexpr input-str)))
(apply + (filter number? json-items)))
(module+ test
(define input-str (file->string "../day12-input.txt"))
(check-equal? (q1 input-str) 191164)
(check-equal? (q2 input-str) 87842))

@ -0,0 +1,75 @@
#lang typed/racket
(require typed/rackunit trivial/regexp/no-colon)
(provide (all-defined-out))
(: happiness-scores (HashTable (List String String) Integer))
(define happiness-scores (make-hash))
(: parse-happiness-score (-> String Void))
(define (parse-happiness-score ln)
(define result
(regexp-match #px"^(.*?) would (gain|lose) (\\d+) happiness units by sitting next to (.*?)\\.$" (string-downcase ln)))
(when result
(match-define (list _ name1 op amount name2) result)
(hash-set! happiness-scores (list name1 name2)
((if (equal? op "gain") + -) (cast (string->number amount) Natural)))))
(: calculate-happiness (-> (Listof String) Integer))
(define (calculate-happiness table-arrangement)
(define table-arrangement-rotated-one-place
(append (drop table-arrangement 1) (take table-arrangement 1)))
(define clockwise-duos
(for/list : (Listof (List String String))
([left table-arrangement]
[right table-arrangement-rotated-one-place])
(list left right)))
;bg;(map list table-arrangement table-arrangement-rotated-one-place)
(define counterclockwise-duos
(for/list : (Listof (List String String))
([lr (in-list clockwise-duos)])
(list (cadr lr) (car lr))))
;bg;(map (ann reverse (-> (List String String) (List String String))) clockwise-duos)
(define all-duos (append clockwise-duos counterclockwise-duos))
(for/sum : Integer ([duo : (List String String) (in-list all-duos)])
(hash-ref happiness-scores duo)))
;;bg
(: flatten2 (-> (Listof (List String String)) (Listof String)))
(define (flatten2 xss)
(for*/list : (Listof String)
([xs (in-list xss)]
[x (in-list xs)])
x))
(: q1 (-> String Integer))
(define (q1 input-str)
(for-each parse-happiness-score (string-split input-str "\n"))
(define names : (Listof String)
(remove-duplicates (flatten2 (hash-keys happiness-scores))))
(define table-arrangement-scores
(for/list : (Listof Integer) ([partial-table-arrangement (in-permutations (cdr names))])
(define table-arrangement (cons (car names) partial-table-arrangement))
(calculate-happiness table-arrangement)))
(apply max table-arrangement-scores))
(: q2 (-> String Integer))
(define (q2 input-str)
(define names
(remove-duplicates (flatten2 (hash-keys happiness-scores))))
(for* ([name (in-list names)]
[duo-proc : (-> String String (List String String)) (in-list (list (λ ([x : String] [y : String]) (list x y)) (λ ([x : String] [y : String]) (list y x))))]) ;;bg
(hash-set! happiness-scores (duo-proc "me" name) 0))
(define table-arrangement-scores
(for/list : (Listof Integer)
([partial-table-arrangement (in-permutations names)])
(define table-arrangement (cons "me" partial-table-arrangement))
(calculate-happiness table-arrangement)))
(apply max table-arrangement-scores))
(module+ test
(define input-str (file->string "../day13-input.txt"))
(check-equal? (q1 input-str) 709)
(check-equal? (q2 input-str) 668))

@ -0,0 +1,75 @@
#lang typed/racket
(require typed/rackunit (for-syntax racket/file))
(provide (all-defined-out))
(define-syntax (convert-input-to-reindeer-functions stx)
(syntax-case stx ()
[(_)
(let* ([input-strings (file->lines "../day14-input.txt")]
[reindeer-strings
(map (λ(str) (format "(reindeer ~a)" (string-downcase str))) input-strings)]
[reindeer-datums
(map (compose1 read open-input-string) reindeer-strings)])
(datum->syntax stx `(begin ,@reindeer-datums)))]))
(define-type Deer-Func (-> Integer Natural))
(define-syntax (reindeer stx)
(syntax-case stx (can fly seconds but then must rest for)
[(_ deer-name can fly speed km/s for fly-secs seconds, but then must rest for rest-secs seconds.)
#'(define (deer-name (total-secs : Integer)) : Natural
(calc-distance total-secs speed fly-secs rest-secs))]
[else #'(void)]))
(convert-input-to-reindeer-functions)
(: calc-distance (-> Integer Natural Natural Natural Natural))
(define (calc-distance total-secs speed fly-secs rest-secs)
(let loop : Natural ([secs-remaining : Integer total-secs] [distance : Natural 0])
(if (<= secs-remaining 0)
distance
(let ([secs-in-flight (min secs-remaining fly-secs)])
(loop (- secs-remaining fly-secs rest-secs)
(+ (* secs-in-flight speed) distance))))))
(: q1 (-> Natural))
(define (q1)
(define seconds-to-travel 2503)
(apply max (map (λ((deer-func : Deer-Func)) (deer-func seconds-to-travel))
(list dasher dancer prancer vixen comet
cupid donner blitzen rudolph))))
;;bg added submodule, because (HashTable A B) cannot be converted to a flat contract :/
(module sugar racket/base
(require (only-in sugar/list frequency-hash))
(define frequency-list
(compose1 hash-values frequency-hash))
(provide frequency-list))
(require/typed (submod "." sugar)
(frequency-list (-> (Listof Any) (Listof Natural))))
(: q2 (-> Natural))
(define (q2)
(define deer-funcs (list dasher dancer prancer vixen comet
cupid donner blitzen rudolph))
(define winners
(frequency-list
(flatten
(for/list : (Listof Any) ([sec (in-range 1 (add1 2503))])
(define deer-results
(map (λ([deer-func : Deer-Func]) (deer-func sec)) deer-funcs))
(define max-result (apply max deer-results))
(map (λ([deer-result : Natural] [deer-func : Deer-Func])
(if (= deer-result max-result)
deer-func
empty))
deer-results deer-funcs)))))
(apply max winners))
(module+ test
(define input-str (file->string "../day14-input.txt"))
(check-equal? (q1) 2640)
(check-equal? (q2) 1102))

@ -0,0 +1,72 @@
#lang typed/racket
(require typed/rackunit)
(provide (all-defined-out))
(: str->ingredient-hash (-> String (HashTable String (Listof Integer))))
(define (str->ingredient-hash str)
(for/hash : (HashTable String (Listof Integer))
([ln (in-list (string-split (string-replace str "," " ") "\n"))])
(match-define (list ingredient-name characteristic-string)
(string-split ln ":"))
(values ingredient-name
(filter exact-integer? ;;bg;number?
(map string->number
(string-split characteristic-string))))))
(: make-recipes (-> Integer Integer (Listof (Listof Integer))))
(define (make-recipes how-many-ingredients total-tsps)
(cond
[(= 0 how-many-ingredients) empty]
[(= 1 how-many-ingredients) (list (list total-tsps))]
[else
(append*
(for/list ([first-amount (in-range (add1 total-tsps))])
: (Listof (Listof (Listof Integer)))
(map (λ ([x : (Listof Integer)]) (cons first-amount x)) ;(curry cons first-amount)
(make-recipes (sub1 how-many-ingredients)
(- total-tsps first-amount)))))]))
(: q1 (-> String Integer))
(define (q1 input-str)
(define ingredient-hash (str->ingredient-hash input-str))
(define ingredients (hash-keys ingredient-hash))
(define how-many-characteristics (length (car (hash-values ingredient-hash))))
(define tsps 100)
(define scores
(for/list ([recipe (in-list (make-recipes (length ingredients) tsps))])
: (Listof Integer)
(for/product : Integer ([char-idx (in-range (sub1 how-many-characteristics))])
(max 0 (for/sum : Integer
([tsp-quantity (in-list recipe)]
[ingredient (in-list ingredients)])
(* tsp-quantity
(list-ref (hash-ref ingredient-hash ingredient) char-idx)))))))
(apply max scores))
(: q2 (-> String Integer))
(define (q2 input-str)
(define ingredient-hash (str->ingredient-hash input-str))
(define ingredients (hash-keys ingredient-hash))
(define how-many-characteristics (length (car (hash-values ingredient-hash))))
(define tsps 100)
(: recipe->calories (-> (Listof Integer) Integer))
(define (recipe->calories recipe)
(for/sum : Integer ([tsp-quantity (in-list recipe)]
[ingredient (in-list ingredients)])
(* tsp-quantity (last (hash-ref ingredient-hash ingredient (λ () (error 'bg)))))))
(define scores
(for/list : (Listof Integer) ([recipe (in-list (make-recipes (length ingredients) tsps))]
#:when (= 500 (recipe->calories recipe)))
(for/product : Integer ([char-idx (in-range (sub1 how-many-characteristics))])
(max 0 (for/sum : Integer ([tsp-quantity (in-list recipe)]
[ingredient (in-list ingredients)])
(* tsp-quantity
(list-ref (hash-ref ingredient-hash ingredient) char-idx)))))))
(apply max scores))
(module+ test
(define input-str (file->string "../day15-input.txt"))
(check-equal? (q1 input-str) 18965440)
(check-equal? (q2 input-str) 15862900))

@ -0,0 +1,77 @@
#lang typed/racket
;;bg; wow this one came out ugly
(require typed/rackunit trivial/regexp/no-colon)
(provide (all-defined-out))
(: parse-sues (-> String (Listof (Listof String))))
(define (parse-sues str)
(for/list ([ln (in-list (string-split str "\n"))])
: (Listof (Listof String))
(define attr-str (second (or (regexp-match #px"^.*?: (.*)$" ln) (error 'bg))))
(string-split attr-str ", ")))
(define master-attrs (file->lines "../day16-input-master-attrs.txt"))
(: q1 (-> String (U #f Integer)))
(define (q1 input-str)
(define sues (parse-sues input-str))
(for/or ([(sue-attrs sue-number) (in-indexed sues)])
: (U #f Integer)
(let loop : (U #f Integer) ([sue-attrs sue-attrs] [acc : (U #f Integer) #f])
(cond
[(null? sue-attrs)
acc]
[(member (car sue-attrs) master-attrs)
(loop (cdr sue-attrs) (add1 sue-number))]
[else
#f]))))
;(for/and ([sue-attr (in-list sue-attrs)])
; : (U #f Integer)
; (and (member sue-attr master-attrs) (add1 sue-number)))
(: q2 (-> String (U #f Integer)))
(define (q2 input-str)
(: attrs->datums (-> (Listof Any) (Listof (Listof Any))))
(define (attrs->datums attrs)
(map (λ (attr) (cast (read (open-input-string (format "(~a)" attr))) (Listof Any))) ;;bg;
#;(compose1 read open-input-string
(λ(attr) (format "(~a)" attr))) attrs))
(define sues (for/list ([sue-attrs (parse-sues input-str)])
: (Listof (Listof (Listof Any)))
(attrs->datums sue-attrs)))
(define master-datums : (Listof (List Symbol Index))
(cast (attrs->datums master-attrs) (Listof (List Symbol Index))))
(for/or ([(sue-datums sue-number) (in-indexed sues)])
: (U #f Integer)
(let loop : (U #f Integer) ([sue-datums : (Listof (Listof Any)) sue-datums] [acc : (U #f Integer) #f])
(if (null? sue-datums)
acc
(let* ([sue-key (caar sue-datums)]
[sue-value (cast (cadar sue-datums) Natural)]
[master-value (second (or (assoc sue-key master-datums) (error 'bg)))]
[cmp (case sue-key
[(cats: trees:) >]
[(pomeranians: goldfish:) <]
[else =])])
(if (cmp sue-value master-value)
(loop (cdr sue-datums) (add1 sue-number))
#f))))))
;(for/and ([sue-datum (in-list sue-datums)])
; : (U #f Integer)
; (and
; (let* ([sue-key (first sue-datum)]
; [sue-value (second sue-datum)]
; [master-value (second (assoc sue-key master-datums))]
; [cmp (case sue-key
; [(cats: trees:) >]
; [(pomeranians: goldfish:) <]
; [else =])])
; (cmp sue-value master-value))
; (add1 sue-number)))) )
(module+ test
(define input-str (file->string "../day16-input.txt"))
(check-equal? (q1 input-str) 103)
(check-equal? (q2 input-str) 405))

@ -0,0 +1,36 @@
#lang typed/racket
(require typed/rackunit)
(provide (all-defined-out))
(: powerset (All (A) (-> (Listof A) (Listof (Listof A)))))
(define (powerset xs)
(if (empty? xs)
(list empty)
(append-map
(λ((s : (Listof A))) (list (cons (car xs) s) s))
(powerset (cdr xs)))))
(: string->integer (-> String Integer))
(define (string->integer s)
(cast (string->number s) Integer))
(: q1 (-> String Integer))
(define (q1 input-str)
(define containers
(map string->integer (string-split input-str)))
(length (filter (λ((s : (Listof Integer))) (= 150 (apply + s)))
(powerset containers))))
(: q2 (-> String Integer))
(define (q2 input-str)
(define containers
(map string->integer (string-split input-str)))
(let* ([winners (filter (λ((s : (Listof Integer))) (= 150 (apply + s)))
(powerset containers))]
[shortest (apply min (map (inst length Any) winners))]) ;;bg; why
(length (filter (λ((w : (Listof Any))) (= shortest (length w))) winners))))
(module+ test
(define input-str (file->string "../day17-input.txt"))
(check-equal? (q1 input-str) 1638)
(check-equal? (q2 input-str) 17))

@ -0,0 +1,94 @@
#lang typed/racket
(require typed/rackunit)
(provide (all-defined-out))
(require/typed racket/vector ;;bg; not sure how to express "a pattern, repeating"
(vector-set*! (All (A) (-> (Vectorof A) Integer A Integer A Integer A Integer A Void))))
(define grid-side 102)
(: rowcol->idx (-> Integer Integer Integer))
(define (rowcol->idx row col) (+ (* grid-side row) col))
(: idx->rowcol (-> Integer (Values Integer Integer)))
(define (idx->rowcol idx) (quotient/remainder idx grid-side))
(: count-lit (-> (Vectorof Integer) Integer))
(define (count-lit grid) (apply + (vector->list grid)))
(define bulb-on 1)
(define bulb-off 0)
(: input->grid (-> String (Vectorof Integer)))
(define (input->grid str)
(define grid-vec : (Vectorof Integer) (make-vector (* grid-side grid-side) bulb-off))
(for* ([(bulb-row bulb-row-idx) (in-indexed (string-split str))]
[(bulb bulb-col-idx) (in-indexed (regexp-match* #rx"." bulb-row))])
(vector-set! grid-vec (rowcol->idx (add1 bulb-row-idx) (add1 bulb-col-idx))
(if (equal? bulb "#") bulb-on bulb-off)))
grid-vec)
(: bulb+adjacents (-> (Vectorof Integer) Integer (Vectorof Integer)))
(define (bulb+adjacents grid grid-idx)
(define-values (row col) (idx->rowcol grid-idx))
(for*/vector ([r (in-range (sub1 row) (+ row 2))]
[c (in-range (sub1 col) (+ col 2))])
: Integer
(vector-ref grid (rowcol->idx r c))))
(: iterate-grid (-> (Vectorof Integer) (Vectorof Integer)))
(define (iterate-grid grid)
(for*/vector ([row (in-range grid-side)]
[col (in-range grid-side)])
: Integer
(cond
[(or (= row 0) (= col 0)
(= row (sub1 grid-side))
(= col (sub1 grid-side)))
bulb-off]
[else
(define bulb-idx (rowcol->idx row col))
(define bulb (vector-ref grid bulb-idx))
(define lit-neighbors
(- (count-lit (bulb+adjacents grid bulb-idx)) bulb))
(cond
[(= bulb-on bulb) (if (<= 2 lit-neighbors 3) bulb-on bulb-off)]
[(= 3 lit-neighbors) bulb-on]
[else bulb-off])])))
(: q1 (-> String Integer))
(define (q1 input-str)
(define initial-grid (input->grid input-str))
(define iterations 100)
(define final-grid (for/fold : (Vectorof Integer)
([grid-so-far : (Vectorof Integer) initial-grid])
([i (in-range iterations)])
(iterate-grid grid-so-far)))
(count-lit final-grid))
(: light-corners (-> (Vectorof Integer) (Vectorof Integer)))
(define (light-corners grid)
(vector-set*! grid
(rowcol->idx 1 1) bulb-on
(rowcol->idx 1 100) bulb-on
(rowcol->idx 100 1) bulb-on
(rowcol->idx 100 100) bulb-on)
grid)
(: q2 (-> String Integer))
(define (q2 input-str)
(define initial-grid (light-corners (input->grid input-str)))
(define iterations 100)
(define final-grid (for/fold : (Vectorof Integer)
([grid-so-far initial-grid])
([i (in-range iterations)])
(light-corners (iterate-grid grid-so-far))))
(count-lit final-grid))
(module+ test
(define input-str (file->string "../day18-input.txt"))
(check-equal? (q1 input-str) 821)
(check-equal? (q2 input-str) 886))

@ -0,0 +1,59 @@
#lang typed/racket
(require typed/rackunit)
(provide (all-defined-out))
(require/typed racket/function ;;bg
(curryr (-> (-> String String (Listof String)) String (-> String (Listof String)))))
(: parse-input-str (-> String (Values String (Listof (Listof String)))))
(define (parse-input-str input-str)
(match-define (cons molecule transformation-strings)
(reverse (string-split input-str "\n")))
(define transformations
(filter-not empty?
(map (curryr string-split " => ")
transformation-strings)))
(values molecule transformations))
(: transform-molecule* (-> String String String (Listof String)))
(define (transform-molecule* molecule target-atom replacement-atom)
(for/list ([pos (in-list (ann (or (regexp-match-positions* (regexp target-atom) molecule) (error 'bg)) (Listof (U #f (Pairof Integer Integer)))))])
: (Listof String)
(match-define (cons start finish) (if (pair? pos) pos (error 'bg)))
(string-append (substring molecule 0 start)
replacement-atom
(substring molecule finish (string-length molecule)))))
(: q1 (-> String Natural))
(define (q1 input-str)
(define-values (molecule transformations) (parse-input-str input-str))
(length
(remove-duplicates
((inst append-map String String String) (λ([target : String] [replacement : String])
(transform-molecule* molecule target replacement))
(map (inst first String String) transformations)
(map (inst second String String String) transformations)))))
(: q2 (-> String Integer))
(define (q2 input-str)
(define-values (starting-molecule xforms) (parse-input-str input-str))
(let loop : Integer ([current-mol starting-molecule][transform-count 0]
[shuffles 0][xforms xforms])
(cond
[(equal? current-mol "e") transform-count]
[else
(define-values (xformed-mol last-count)
(for/fold : (Values String Integer)
([mol current-mol][count-so-far transform-count])
([(from to) (in-parallel (map (inst first String String) xforms) (map (inst second String String String) xforms))])
(values (string-replace mol to from)
(+ count-so-far (length (regexp-match* to mol))))))
(if (not (equal? current-mol xformed-mol))
(loop xformed-mol last-count shuffles xforms)
(loop starting-molecule 0 (add1 shuffles) (shuffle xforms)))])))
(module+ test
(define input-str (file->string "../day19-input.txt"))
(check-equal? (q1 input-str) 576)
(check-equal? (q2 input-str) 207))

@ -0,0 +1,35 @@
#lang typed/racket
(require typed/rackunit (only-in math divisors))
(provide (all-defined-out))
(: q1 (-> String (U #f Integer)))
(define (q1 input-str)
(define target-gifts (cast (read (open-input-string input-str)) Natural))
(define gifts-per-elf 10)
(for/or : (U #f Integer) ([house-number (in-naturals)]
#:when (let* ([elves (divisors house-number)]
[elf-gifts
(apply + (map (ann (curry * gifts-per-elf) (-> Natural Natural)) elves))])
(>= elf-gifts target-gifts)))
house-number))
(: q2 (-> String (U #f Integer)))
(define (q2 input-str)
(define target-gifts (cast (read (open-input-string input-str)) Natural))
(define gifts-per-elf 11)
(for/or : (U #f Integer) ([house-number (in-naturals)]
#:when (let* ([elves (divisors house-number)]
[elves (filter
(λ([e : Integer]) (<= house-number (* 50 e))) elves)]
[elf-gifts
(apply + (map (ann (curry * gifts-per-elf) (-> Natural Natural)) elves))])
(>= elf-gifts target-gifts)))
house-number))
(module+ test
(define input-str (file->string "../day20-input.txt"))
(check-equal? (q1 input-str) 831600)
(check-equal? (q2 input-str) 884520))

@ -0,0 +1,114 @@
#lang typed/racket
(define-type Item (List Symbol Natural Natural Natural))
(define-type HP Integer)
(define-type Attack-Power Natural)
(define-type Defense-Power Natural)
(define-type Player (List HP Attack-Power Defense-Power))
(define no-item : Item
'(None 0 0 0))
(define weapons : (Listof Item)
'((Dagger 8 4 0)
(Shortsword 10 5 0)
(Warhammer 25 6 0)
(Longsword 40 7 0)
(Greataxe 74 8 0)))
(define armors : (Listof Item)
'((Leather 13 0 1)
(Chainmail 31 0 2)
(Splintmail 53 0 3)
(Bandedmail 75 0 4)
(Platemail 102 0 5)))
(define rings : (Listof Item)
'((Damage+1 25 1 0)
(Damage+2 50 2 0)
(Damage+3 100 3 0)
(Defense+1 20 0 1)
(Defense+2 40 0 2)
(Defense+3 80 0 3)))
(require typed/rackunit)
(provide (all-defined-out))
(: cost (-> (Listof Item) Natural))
(define (cost equipment-set)
(apply + (map (inst second Any Natural Any) equipment-set)))
(: equipment-sets-by-cost (Listof (Listof Item)))
(define equipment-sets-by-cost
(let ([equipment-sets
(for*/list ([weapon (in-list weapons)]
[armor (in-list (cons no-item armors))]
[lh-ring (in-list (cons no-item rings))]
[rh-ring (in-list (cons no-item (remove lh-ring rings)))])
: (Listof (List Item Item Item Item))
(list weapon armor lh-ring rh-ring))])
((inst sort (Listof Item) Natural) equipment-sets < #:key cost)))
(define player-hit-points 100)
(define min-damage 1)
(: equipment-set->player (-> (Listof Item) Player))
(define (equipment-set->player equipment-set)
(let ([total-damage (apply + (map (inst third Any Any Natural Any) equipment-set))]
[total-armor (apply + (map (inst fourth Any Any Any Natural Any) equipment-set))])
(list player-hit-points total-damage total-armor)))
(: player-turn? (-> Integer Boolean))
(define player-turn? even?)
(: hit-points (-> Player HP))
(define hit-points first)
(: damage (-> Player Attack-Power))
(define damage second)
(: armor (-> Player Defense-Power))
(define armor third)
(: attack (-> Player Player Player))
(define (attack attacker defender)
(define net-damage (max (- (damage attacker) (armor defender)) min-damage))
(list (- (hit-points defender) net-damage) (damage defender) (armor defender)))
(: we-win? (-> Player Player Boolean))
(define (we-win? player boss)
(define-values (last-player-state last-boss-state)
(let loop : (Values Player Player)
;;bg;(for/fold : (Values Player Player)
([player-state : Player player][boss-state : Player boss]
[turn-number : Natural 0]
;;bg; #:break
)
(cond
[(<= (min (hit-points player-state) (hit-points boss-state)) 0)
(values player-state boss-state)]
[(player-turn? turn-number)
(loop player-state (player-state . attack . boss-state) (+ 1 turn-number))]
[else
(loop (boss-state . attack . player-state) boss-state (+ 1 turn-number))])))
(<= (hit-points last-boss-state) 0))
(: q1 (-> String (U #f Integer)))
(define (q1 input-str)
(define boss (cast (filter number? (map string->number (string-split input-str))) Player))
(for/or : (U #f Integer) ([equip (in-list equipment-sets-by-cost)]
#:when (let ([player (equipment-set->player equip)])
(we-win? player boss)))
(cost equip)))
(: q2 (-> String (U #f Integer)))
(define (q2 input-str)
(define boss (cast (filter number? (map string->number (string-split input-str))) Player))
(for/or : (U #f Integer) ([equip (in-list (reverse equipment-sets-by-cost))]
#:when (let ([player (equipment-set->player equip)])
(not (we-win? player boss))))
(cost equip)))
(module+ test
(define input-str (file->string "../day21-input.txt"))
(check-equal? (q1 input-str) 111)
(check-equal? (q2 input-str) 188))

@ -0,0 +1,206 @@
#lang typed/racket
(define BASE-HP 50)
(define BASE-MANA 500)
(define MAGIC-MISSILE-DAMAGE 4)
(define DRAIN-DAMAGE 2)
(define SHIELD-ARMOR 7)
(define SHIELD-DURATION 6)
(define POISON-DAMAGE 3)
(define POISON-DURATION 6)
(define RECHARGE-MANA 101)
(define RECHARGE-DURATION 5)
(struct player (
[hp : Integer]
[attack : Natural]
[mana : Integer]
) #:transparent)
(define-type Player player)
(define-type Spell (U 'magic-missile 'drain 'shield 'poison 'recharge))
(define-type Active-Spells (Listof (Pairof Natural Spell)))
;(define-type Game-State (Values Player Player Active-Spells))
(define ALL-SPELLS : (Listof Spell)
'(magic-missile
drain
shield
poison
recharge))
(: unknown-spell (All (A) (-> Spell A)))
(define (unknown-spell spell)
(raise-user-error 'day22 "Unknown spell '~a'" spell))
(: spell-mana (-> Spell Natural))
(define (spell-mana s)
(case s
[(magic-missile)
53]
[(drain)
73]
[(shield)
113]
[(poison)
173]
[(recharge)
229]
[else
(unknown-spell s)]))
(: spell*-mana (-> (Listof Spell) Natural))
(define (spell*-mana spell*)
(for/sum : Natural ([spell (in-list spell*)])
(spell-mana spell)))
(: make-player (-> Player))
(define (make-player)
(player BASE-HP 0 BASE-MANA))
(: make-boss (-> Index * Player))
(define (make-boss . val*)
(player (car val*) (cadr val*) 0))
(: hp+ (-> Player Integer Player))
(define (hp+ p val)
(match-define (player hp attack mana) p)
(player (+ hp val) attack mana))
(: hp- (-> Player Integer Player))
(define (hp- p val)
(hp+ p (- val)))
(: mana+ (-> Player Integer Player))
(define (mana+ p val)
(match-define (player hp attack mana) p)
(player hp attack (+ mana val)))
(: mana- (-> Player Integer Player))
(define (mana- p val)
(mana+ p (- val)))
(: active? (-> Spell Active-Spells Boolean))
(define (active? spell active-spells)
(for/or : Boolean
([ctr+spell (in-list active-spells)])
(eq? spell (cdr ctr+spell))))
(: has-enough-mana? (-> Player Spell Boolean))
(define (has-enough-mana? player spell)
(<= (spell-mana spell) (player-mana player)))
(: boss-attack (-> Player Player Boolean Player))
(define (boss-attack player boss shield?)
(define boss-damage (max 1 (- (player-attack boss) (if shield? SHIELD-ARMOR 0))))
(hp- player boss-damage))
(: apply-effects (-> Player Player (Listof (Pairof Natural Spell)) (Values Player Player Active-Spells)))
(define (apply-effects player boss spells)
(for/fold ([p+ : Player player]
[b+ : Player boss]
[a+ : Active-Spells '()])
([ctr+spell (in-list spells)])
(match-define (cons ctr spell) ctr+spell)
(define a++ (if (= 1 ctr) a+ (cons (cons (assert (- ctr 1) index?) spell) a+)))
(case spell
[(poison)
(values p+ (hp- b+ POISON-DAMAGE) a++)]
[(recharge)
(values (mana+ p+ RECHARGE-MANA) b+ a++)]
[(shield)
(values p+ b+ a++)]
[else
(unknown-spell spell)])))
(: apply-spell (-> Spell Player Player Active-Spells (Values Player Player Active-Spells)))
(define (apply-spell spell player0 boss active-spells)
(define player (mana- player0 (spell-mana spell)))
(case spell
[(magic-missile)
(values player (hp- boss MAGIC-MISSILE-DAMAGE) active-spells)]
[(drain)
(values (hp+ player DRAIN-DAMAGE) (hp- boss DRAIN-DAMAGE) active-spells)]
[(shield)
(values player boss (cons (cons SHIELD-DURATION 'shield) active-spells))]
[(poison)
(values player boss (cons (cons POISON-DURATION 'poison) active-spells))]
[(recharge)
(values player boss (cons (cons RECHARGE-DURATION 'recharge) active-spells))]
[else
(unknown-spell spell)]))
(: win? (-> Player Player Boolean))
(define (win? player boss)
(dead? boss))
(: dead? (-> Player Boolean))
(define (dead? player)
(<= (player-hp player) 0))
(: lose? (-> Player Player Boolean))
(define lose?
(let ([MIN-MANA (apply min (map spell-mana ALL-SPELLS))])
(λ (player boss)
(or (dead? player)
(< (player-mana player) MIN-MANA)))))
(: win/least-mana : Player Player [#:hard-mode? Boolean] -> (Listof Spell))
(define (win/least-mana player boss #:hard-mode? [hard-mode? #f])
(or
(let maybe-win/least-mana : (U #f (Listof Spell))
([player : Player player]
[boss : Player boss]
[active-spells : Active-Spells '()]
[current-turn : Natural 0])
(cond
[(lose? player boss)
#f]
[(win? player boss)
'()]
[else
(define-values (p+ b+ a+) (apply-effects player boss active-spells))
(define next-turn (+ 1 current-turn))
(if (even? current-turn)
(let ([p+ (if hard-mode? (hp- p+ 1) p+)])
(minimize-mana
(for/list : (Listof (U #f (Listof Spell)))
([spell (in-list ALL-SPELLS)]
#:when (and (not (active? spell a+))
(has-enough-mana? p+ spell)))
(define-values (p++ b++ a++) (apply-spell spell p+ b+ a+))
(define future-spells (maybe-win/least-mana p++ b++ a++ next-turn))
(and future-spells (cons spell future-spells)))))
(maybe-win/least-mana (boss-attack p+ b+ (active? 'shield a+)) b+ a+ next-turn))]))
(raise-user-error 'day22 "Impossible for ~a to beat ~a. Sorry.\n" player boss)))
(: minimize-mana (-> (Listof (U #f (Listof Spell))) (U #f (Listof Spell))))
(define (minimize-mana spell**)
(for/fold : (U #f (Listof Spell))
([best : (U #f (Listof Spell)) #f])
([other : (U #f (Listof Spell)) (in-list spell**)])
(if (or (not best)
(and best other (< (spell*-mana other) (spell*-mana best))))
other
best)))
(: q1 (-> String Integer))
(define (q1 input-str)
(define player (make-player))
(define boss (apply make-boss (filter index? (map string->number (string-split input-str)))))
(spell*-mana (win/least-mana player boss)))
(: q2 (-> String Integer))
(define (q2 input-str)
(define player (make-player))
(define boss (apply make-boss (filter index? (map string->number (string-split input-str)))))
(spell*-mana (win/least-mana player boss #:hard-mode? #t)))
(module+ test
(require typed/rackunit)
(define input-str (file->string "../day22-input.txt"))
(check-equal? (q1 input-str) 1269)
(check-equal? (q2 input-str) 1309))

@ -0,0 +1,67 @@
#lang typed/racket
(require typed/rackunit
(for-syntax racket/file racket/string sugar/debug))
(provide (all-defined-out))
(require/typed racket/base
(hash-set*! (-> (HashTable Symbol Integer) Symbol Integer Symbol Integer Void)))
(define-syntax (convert-input-to-instruction-functions stx)
(syntax-case stx ()
[(_)
(let* ([input-strings (file->lines "../day23-input.txt")]
[inst-strings (map (λ(str) (format "(λ(_) (inst ~a))" (string-replace str "," ""))) input-strings)] ;;bg; removed thunk*
[inst-datums (map (compose1 read open-input-string) inst-strings)])
(datum->syntax stx `(define instructions : (Listof (-> Integer Integer)) (list ,@inst-datums))))]))
(: registers (HashTable Symbol Integer))
(define registers (make-hash '((a . 0)(b . 0))))
(define default-offset 1)
(define-syntax-rule (define-reg-updater id thunk)
(define (id (reg : Symbol)) : Integer
(hash-update! registers reg thunk)
default-offset))
(define-reg-updater tpl (λ([val : Integer]) (* 3 val)))
(define-reg-updater inc (λ([val : Integer]) (add1 val)))
(define-reg-updater hlf (λ([val : Integer]) (cast (/ val 2) Integer)))
(: jmpf (-> Symbol Integer (-> Integer Any) Integer))
(define (jmpf reg num pred)
(if (pred (hash-ref registers reg (λ () -1))) num 1))
(define-syntax (inst stx)
(syntax-case stx (jmp jio jie)
[(_ jio reg num)
#'(jmpf 'reg num (curry = 1))]
[(_ jie reg num)
#'(jmpf 'reg num even?)]
[(_ jmp num)
#'num]
[(_ op reg)
#'(op 'reg)]))
(convert-input-to-instruction-functions)
(: q1 (-> Integer))
(define (q1)
(let eval-instruction : Integer ([idx 0])
(if (>= idx (length instructions))
(hash-ref registers 'b)
(let* ([inst (list-ref instructions idx)]
[jump-offset (inst -1)] ;;bg
[next-idx (+ jump-offset idx)])
(eval-instruction next-idx)))))
(: q2 (-> Integer))
(define (q2)
(hash-set*! registers 'a 1 'b 0)
(q1))
(module+ test
(check-equal? (q1) 184)
(check-equal? (q2) 231))

@ -0,0 +1,92 @@
#lang typed/racket
(require typed/rackunit)
(provide (all-defined-out))
(: groups (-> (Listof Integer) Integer Integer (Listof (Listof Integer))))
(define (groups packages len goal-weight)
(cond
[(= len 0) empty]
[(= len 1) (map (ann list (-> Integer (Listof Integer))) (filter (ann (curry = goal-weight) (-> Integer Boolean)) packages))] ;;bg OMG
[else
(append*
(for/list ([x (in-list packages)])
: (Listof (Listof (Listof Integer)))
(define later-packages (cdr (or (member x packages) (error 'bg))))
(append-map (λ([ss : (Listof Integer)]) (define new-group (cons x ss))
(if (= goal-weight (weight new-group))
(list new-group)
empty))
(groups later-packages (sub1 len) (- goal-weight x)))))]))
(: weight (-> (Listof Integer) Integer))
(define (weight group) (apply + group))
(: quantum-entanglement (-> (Listof Integer) Integer))
(define (quantum-entanglement group) (apply * group))
(: remove-group (-> (Listof Integer) (Listof Integer) (Listof Integer)))
(define (remove-group group packages)
(filter (λ([p : Integer]) (not (member p group))) packages))
(: has-solution? (-> (Listof Integer) (Listof Integer) Boolean))
(define (has-solution? group packages)
(define target-weight (weight group))
(define remaining-packages (remove-group group packages))
(for/or : Boolean ([len (in-range (length remaining-packages))]
#:when (not (empty?
(groups remaining-packages len target-weight))))
#t))
(: find-three-group-solution (-> (Listof Integer) Integer (U #f Integer)))
(define (find-three-group-solution all-packages target-weight)
(for/or : (U #f Integer) ([len (in-range (length all-packages))]) ;;bg cannot do for*/or
(let loop : (U #f Integer) (
[groups ;in-list
((inst sort (Listof Integer) Integer)
(groups all-packages len target-weight)
#:key quantum-entanglement <)])
(cond
[(null? groups)
#f]
[(has-solution? (car groups) all-packages)
(quantum-entanglement (car groups))]
[else
(loop (cdr groups))]))))
; #:when (has-solution? group all-packages))
; (quantum-entanglement group)))
(: q1 (-> String (U #f Integer)))
(define (q1 input-str)
(define all-packages (map string->integer (string-split input-str)))
(define target-weight (cast (/ (weight all-packages) 3) Integer))
(find-three-group-solution all-packages target-weight))
;;bg
(: string->integer (-> String Integer))
(define (string->integer s)
(cast (string->number s) Integer))
(: q2 (-> String (U #f Integer)))
(define (q2 input-str)
(define all-packages (map string->integer (string-split input-str)))
(define target-weight (cast (/ (weight all-packages) 4) Integer))
(for/or : (U #f Integer) ([len (in-range (length all-packages))]) ;;bg cannot do for*/or
(let loop : (U #f Integer) (
[groups ((inst sort (Listof Integer) Integer)
(groups all-packages len target-weight)
#:key quantum-entanglement <)])
(cond
[(null? groups)
#f]
[(find-three-group-solution
(remove-group (car groups) all-packages) target-weight)
(quantum-entanglement (car groups))]
[else
(loop (cdr groups))]))))
(module+ test
(define input-str (file->string "../day24-input.txt"))
(check-equal? (q1 input-str) 10439961859)
(check-equal? (q2 input-str) 72050269))

@ -0,0 +1,33 @@
#lang typed/racket
(require typed/rackunit)
(provide (all-defined-out))
(define first-code 20151125)
(: next-code (-> Integer Integer))
(define (next-code code)
(modulo (* code 252533) 33554393))
(: nth-code (-> Integer Integer))
(define (nth-code n)
(for/fold : Integer ([code-so-far first-code])
([i (in-range (sub1 n))])
(next-code code-so-far)))
(: rc->n (-> Integer Integer Integer))
(define (rc->n row col)
(define first-col-val (add1 (apply + (range row))))
(define col-offset-val (apply + (range (add1 row) (+ row col))))
(+ first-col-val col-offset-val))
(: q1 (-> String Integer))
(define (q1 input-str)
(match-define (list _ row col)
(map (λ ([s : (U #f String)]) (and s (string->number s)))
(or (regexp-match #px"row (\\d+), column (\\d+)" input-str) (error 'bg))))
(nth-code (rc->n (cast row Integer) (cast col Integer))))
(module+ test
(define input-str (file->string "../day25-input.txt"))
(check-equal? (q1 input-str) 19980801))