From a6ebb9ebc66148b2836a2b587c12f354a97f4d0b Mon Sep 17 00:00:00 2001 From: Ben Greenman Date: Tue, 26 Jul 2016 21:08:49 -0400 Subject: [PATCH 1/3] ** add typed/racket deps --- info.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/info.rkt b/info.rkt index 4765c39..156309a 100644 --- a/info.rkt +++ b/info.rkt @@ -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")) \ No newline at end of file +(define build-deps '("rackunit-lib" "racket-doc" "scribble-doc" "rackunit-doc" "at-exp-lib" "math-doc")) From 70ecb35568f76ee5bfd45e1ebb9437f782ebdc26 Mon Sep 17 00:00:00 2001 From: Ben Greenman Date: Tue, 26 Jul 2016 22:04:49 -0400 Subject: [PATCH 2/3] adapt solutions to Typed Racket Ideally these only add type annotations, but this wasn't always the case - changed for/first to for/or - changed for/and, for*/or, for/fold #:break to named lets - no thunk*, limited curry & compose - require/typed for -set*! functions - handled failure conditions in read, regexp-match Anyway, all unit tests pass and run about the same speed. Grep for "bg" to see interesting changes. --- typed/day01.rkt | 77 ++++++++++++++++++++++++++++++++ typed/day02.rkt | 41 +++++++++++++++++ typed/day03.rkt | 76 ++++++++++++++++++++++++++++++++ typed/day04.rkt | 22 ++++++++++ typed/day05.rkt | 37 ++++++++++++++++ typed/day06.rkt | 99 +++++++++++++++++++++++++++++++++++++++++ typed/day07.rkt | 73 +++++++++++++++++++++++++++++++ typed/day08.rkt | 26 +++++++++++ typed/day09.rkt | 57 ++++++++++++++++++++++++ typed/day10.rkt | 32 ++++++++++++++ typed/day11.rkt | 56 ++++++++++++++++++++++++ typed/day12.rkt | 51 ++++++++++++++++++++++ typed/day13.rkt | 75 +++++++++++++++++++++++++++++++ typed/day14.rkt | 75 +++++++++++++++++++++++++++++++ typed/day15.rkt | 72 ++++++++++++++++++++++++++++++ typed/day16.rkt | 77 ++++++++++++++++++++++++++++++++ typed/day17.rkt | 36 +++++++++++++++ typed/day18.rkt | 94 +++++++++++++++++++++++++++++++++++++++ typed/day19.rkt | 59 +++++++++++++++++++++++++ typed/day20.rkt | 35 +++++++++++++++ typed/day21.rkt | 114 ++++++++++++++++++++++++++++++++++++++++++++++++ typed/day23.rkt | 67 ++++++++++++++++++++++++++++ typed/day24.rkt | 92 ++++++++++++++++++++++++++++++++++++++ typed/day25.rkt | 33 ++++++++++++++ 24 files changed, 1476 insertions(+) create mode 100644 typed/day01.rkt create mode 100644 typed/day02.rkt create mode 100644 typed/day03.rkt create mode 100644 typed/day04.rkt create mode 100644 typed/day05.rkt create mode 100644 typed/day06.rkt create mode 100644 typed/day07.rkt create mode 100644 typed/day08.rkt create mode 100644 typed/day09.rkt create mode 100644 typed/day10.rkt create mode 100644 typed/day11.rkt create mode 100644 typed/day12.rkt create mode 100644 typed/day13.rkt create mode 100644 typed/day14.rkt create mode 100644 typed/day15.rkt create mode 100644 typed/day16.rkt create mode 100644 typed/day17.rkt create mode 100644 typed/day18.rkt create mode 100644 typed/day19.rkt create mode 100644 typed/day20.rkt create mode 100644 typed/day21.rkt create mode 100644 typed/day23.rkt create mode 100644 typed/day24.rkt create mode 100644 typed/day25.rkt diff --git a/typed/day01.rkt b/typed/day01.rkt new file mode 100644 index 0000000..6ad7e28 --- /dev/null +++ b/typed/day01.rkt @@ -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)) + + diff --git a/typed/day02.rkt b/typed/day02.rkt new file mode 100644 index 0000000..fa1b1bf --- /dev/null +++ b/typed/day02.rkt @@ -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)) diff --git a/typed/day03.rkt b/typed/day03.rkt new file mode 100644 index 0000000..9ad6f39 --- /dev/null +++ b/typed/day03.rkt @@ -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)) diff --git a/typed/day04.rkt b/typed/day04.rkt new file mode 100644 index 0000000..96dbe3e --- /dev/null +++ b/typed/day04.rkt @@ -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)) diff --git a/typed/day05.rkt b/typed/day05.rkt new file mode 100644 index 0000000..107a3f5 --- /dev/null +++ b/typed/day05.rkt @@ -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)) diff --git a/typed/day06.rkt b/typed/day06.rkt new file mode 100644 index 0000000..fdf0d44 --- /dev/null +++ b/typed/day06.rkt @@ -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)) + diff --git a/typed/day07.rkt b/typed/day07.rkt new file mode 100644 index 0000000..45b9793 --- /dev/null +++ b/typed/day07.rkt @@ -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)) + diff --git a/typed/day08.rkt b/typed/day08.rkt new file mode 100644 index 0000000..625cf3a --- /dev/null +++ b/typed/day08.rkt @@ -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)) + diff --git a/typed/day09.rkt b/typed/day09.rkt new file mode 100644 index 0000000..b5d67c3 --- /dev/null +++ b/typed/day09.rkt @@ -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 (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)) + + diff --git a/typed/day10.rkt b/typed/day10.rkt new file mode 100644 index 0000000..7686d28 --- /dev/null +++ b/typed/day10.rkt @@ -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)) + + diff --git a/typed/day11.rkt b/typed/day11.rkt new file mode 100644 index 0000000..8b89363 --- /dev/null +++ b/typed/day11.rkt @@ -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")) + + diff --git a/typed/day12.rkt b/typed/day12.rkt new file mode 100644 index 0000000..5b35992 --- /dev/null +++ b/typed/day12.rkt @@ -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)) + diff --git a/typed/day13.rkt b/typed/day13.rkt new file mode 100644 index 0000000..8181c7c --- /dev/null +++ b/typed/day13.rkt @@ -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)) + + diff --git a/typed/day14.rkt b/typed/day14.rkt new file mode 100644 index 0000000..f22fef8 --- /dev/null +++ b/typed/day14.rkt @@ -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)) + diff --git a/typed/day15.rkt b/typed/day15.rkt new file mode 100644 index 0000000..4a690ec --- /dev/null +++ b/typed/day15.rkt @@ -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)) + + diff --git a/typed/day16.rkt b/typed/day16.rkt new file mode 100644 index 0000000..fcef3a7 --- /dev/null +++ b/typed/day16.rkt @@ -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)) + + diff --git a/typed/day17.rkt b/typed/day17.rkt new file mode 100644 index 0000000..d5f6f50 --- /dev/null +++ b/typed/day17.rkt @@ -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)) diff --git a/typed/day18.rkt b/typed/day18.rkt new file mode 100644 index 0000000..68c6858 --- /dev/null +++ b/typed/day18.rkt @@ -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)) + + diff --git a/typed/day19.rkt b/typed/day19.rkt new file mode 100644 index 0000000..51af78a --- /dev/null +++ b/typed/day19.rkt @@ -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)) + diff --git a/typed/day20.rkt b/typed/day20.rkt new file mode 100644 index 0000000..61c24f7 --- /dev/null +++ b/typed/day20.rkt @@ -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)) + + diff --git a/typed/day21.rkt b/typed/day21.rkt new file mode 100644 index 0000000..57b8dae --- /dev/null +++ b/typed/day21.rkt @@ -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)) + + diff --git a/typed/day23.rkt b/typed/day23.rkt new file mode 100644 index 0000000..2db4dac --- /dev/null +++ b/typed/day23.rkt @@ -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)) + + diff --git a/typed/day24.rkt b/typed/day24.rkt new file mode 100644 index 0000000..ef7f67d --- /dev/null +++ b/typed/day24.rkt @@ -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)) + + diff --git a/typed/day25.rkt b/typed/day25.rkt new file mode 100644 index 0000000..32a1a2c --- /dev/null +++ b/typed/day25.rkt @@ -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)) + From 452cb8f0faff770ff58e08cda736234c62d59eaf Mon Sep 17 00:00:00 2001 From: Ben Greenman Date: Tue, 2 Aug 2016 02:15:22 -0400 Subject: [PATCH 3/3] typed day22 --- typed/day22.rkt | 206 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 206 insertions(+) create mode 100644 typed/day22.rkt diff --git a/typed/day22.rkt b/typed/day22.rkt new file mode 100644 index 0000000..dc770b5 --- /dev/null +++ b/typed/day22.rkt @@ -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)) +