aboutsummaryrefslogtreecommitdiff
path: root/aoc2023-other
diff options
context:
space:
mode:
authorHunky Jimpjorps <thechairman@thechairman.info>2024-02-02 17:05:12 -0500
committerHunky Jimpjorps <thechairman@thechairman.info>2024-02-02 17:05:12 -0500
commit48e35ad3b0b0c62f936784e4aca70b17c3b0e3f9 (patch)
treef59a13e0b5e80ab925220b4488c6e36b1bec660a /aoc2023-other
parent87e9ab25ff70e215b537939a4bc23ab101f41dbe (diff)
downloadgleam_aoc-48e35ad3b0b0c62f936784e4aca70b17c3b0e3f9.tar.gz
gleam_aoc-48e35ad3b0b0c62f936784e4aca70b17c3b0e3f9.zip
renaming
Diffstat (limited to 'aoc2023-other')
-rw-r--r--aoc2023-other/day-01/day-01.rkt38
-rw-r--r--aoc2023-other/day-02/day-02-parser.rkt55
-rw-r--r--aoc2023-other/day-02/day-02.rkt35
-rw-r--r--aoc2023-other/day-03/day-03.rkt72
-rw-r--r--aoc2023-other/day-04/day-04.rkt40
-rw-r--r--aoc2023-other/day-05/day-05.rkt91
-rw-r--r--aoc2023-other/day-06/day-06.rkt32
-rw-r--r--aoc2023-other/day-07/day-07.rkt82
-rw-r--r--aoc2023-other/day-08/day-08.rkt36
-rw-r--r--aoc2023-other/day-09/day-09-polynomial.rkt17
-rw-r--r--aoc2023-other/day-09/day-09.rkt32
-rw-r--r--aoc2023-other/day-10/day-10.rkt97
-rw-r--r--aoc2023-other/day-11/day-11.rkt40
-rw-r--r--aoc2023-other/day-12/day-12.rkt65
-rw-r--r--aoc2023-other/day-13/day-13.rkt47
-rw-r--r--aoc2023-other/day-14/day-14.rkt49
-rw-r--r--aoc2023-other/day-15/day-15.rkt41
-rw-r--r--aoc2023-other/day-16/day-16.rkt70
-rw-r--r--aoc2023-other/day-17/day-17.rkt86
-rw-r--r--aoc2023-other/day-18/day-18.rkt48
-rw-r--r--aoc2023-other/day-19/day-19.rkt134
-rw-r--r--aoc2023-other/day-20/day-20.rkt144
-rw-r--r--aoc2023-other/day-21/day-21.rkt69
-rw-r--r--aoc2023-other/day-22/day-22.rkt109
-rw-r--r--aoc2023-other/day-23/day-23.rkt89
-rw-r--r--aoc2023-other/day-24/day-24a.rkt51
-rw-r--r--aoc2023-other/day-24/day-24b.rkt37
-rw-r--r--aoc2023-other/day-25/day-25.rkt43
28 files changed, 0 insertions, 1749 deletions
diff --git a/aoc2023-other/day-01/day-01.rkt b/aoc2023-other/day-01/day-01.rkt
deleted file mode 100644
index b720f79..0000000
--- a/aoc2023-other/day-01/day-01.rkt
+++ /dev/null
@@ -1,38 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading)
-
-(define calibration-values (fetch-aoc-input (find-session) 2023 1))
-
-(define (to-number str)
- (match (string->number str)
- [#false (hash-ref word-to-digit str)]
- [n n]))
-
-(define (parse-calibration-value v valid)
- (for/fold ([acc '()] [value v] #:result (+ (to-number (first acc)) (* 10 (to-number (last acc)))))
- ([_ (in-naturals)])
- #:break (equal? value "")
- (let ([possible-prefix (findf (curry string-prefix? value) valid)])
- (if possible-prefix
- (values (cons possible-prefix acc) (substring value 1))
- (values acc (substring value 1))))))
-
-(define (total-calibration input valid)
- (~> input
- (string-trim)
- (string-split "\n")
- (map (λ~> (parse-calibration-value valid)) _)
- (apply + _)))
-
-;; part 1
-
-(define valid-for-part-1 (~> (range 1 10) (map ~a _)))
-(total-calibration calibration-values valid-for-part-1)
-
-;; part 2
-(define word-to-digit
- (hash "one" 1 "two" 2 "three" 3 "four" 4 "five" 5 "six" 6 "seven" 7 "eight" 8 "nine" 9))
-(define valid-for-part-2 (append valid-for-part-1 (hash-keys word-to-digit)))
-(total-calibration calibration-values valid-for-part-2)
diff --git a/aoc2023-other/day-02/day-02-parser.rkt b/aoc2023-other/day-02/day-02-parser.rkt
deleted file mode 100644
index 76cc24f..0000000
--- a/aoc2023-other/day-02/day-02-parser.rkt
+++ /dev/null
@@ -1,55 +0,0 @@
-#lang racket
-
-(require racket/hash
- advent-of-code
- data/applicative
- data/either
- data/monad
- megaparsack
- megaparsack/text
- threading)
-
-(struct game (id r g b))
-
-(define cube/p
- (do [n <- integer/p]
- space/p
- [c <- (or/p (string/p "red")
- (string/p "blue")
- (string/p "green"))]
- (pure (cons c n))))
-
-(define draw/p
- (do [xs <- (many/p cube/p #:min 1 #:max 3 #:sep (string/p ", "))]
- (pure (apply hash (flatten xs)))))
-
-(define all-draws/p
- (do (string/p "Game ")
- [id <- integer/p]
- (string/p ": ")
- [all-draws <- (many/p draw/p #:min 1 #:sep (string/p "; "))]
- (define maxima
- (foldl (curry hash-union #:combine max)
- (hash "red" 0 "green" 0 "blue" 0)
- all-draws))
- (pure (game id
- (hash-ref maxima "red")
- (hash-ref maxima "green")
- (hash-ref maxima "blue")))))
-
-(define game-maxima
- (~>> (open-aoc-input (find-session) 2023 2)
- port->lines
- (map (λ~>> (parse-string all-draws/p)
- from-either))))
-
-;; part 1
-(for/sum ([m (in-list game-maxima)]
- #:unless (or (> (game-r m) 12)
- (> (game-g m) 13)
- (> (game-b m) 14)))
- (game-id m))
-
-;; part 2
-(for/sum ([m (in-list game-maxima)])
- (* (game-r m) (game-g m) (game-b m)))
diff --git a/aoc2023-other/day-02/day-02.rkt b/aoc2023-other/day-02/day-02.rkt
deleted file mode 100644
index 973d20c..0000000
--- a/aoc2023-other/day-02/day-02.rkt
+++ /dev/null
@@ -1,35 +0,0 @@
-#lang racket
-
-(require advent-of-code)
-
-(struct roll (id red green blue))
-
-(define all-games
- (for/list ([raw-game (in-list (port->lines (open-aoc-input (find-session) 2023 2)))]
- #:do [(define game (string-trim raw-game "Game "))
- (match-define (list id trials) (string-split game ": "))])
- (for/list ([trial (in-list (string-split trials "; "))])
- (for/fold ([acc (roll (string->number id) 0 0 0)])
- ([color (in-list (string-split trial ", "))])
- (match (string-split color)
- [(list (app string->number n) "red") (struct-copy roll acc [red n])]
- [(list (app string->number n) "green") (struct-copy roll acc [green n])]
- [(list (app string->number n) "blue") (struct-copy roll acc [blue n])])))))
-
-;; part 1
-(for/sum ([game (in-list all-games)]
- #:when (andmap (λ (g) (and ((roll-red g) . <= . 12)
- ((roll-green g) . <= . 13)
- ((roll-blue g) . <= . 14)))
- game))
- (roll-id (first game)))
-
-;; part 2
-(for/sum ([game (in-list all-games)])
- (define max-cubes
- (for/fold ([acc (roll #f 0 0 0)]) ([r (in-list game)])
- (roll #f
- (max (roll-red acc) (roll-red r))
- (max (roll-green acc) (roll-green r))
- (max (roll-blue acc) (roll-blue r)))))
- (* (roll-red max-cubes) (roll-green max-cubes) (roll-blue max-cubes)))
diff --git a/aoc2023-other/day-03/day-03.rkt b/aoc2023-other/day-03/day-03.rkt
deleted file mode 100644
index 60e81a6..0000000
--- a/aoc2023-other/day-03/day-03.rkt
+++ /dev/null
@@ -1,72 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading)
-
-(struct posn (x y) #:transparent)
-(struct part (n posns) #:transparent)
-
-(define (make-board port)
- (for*/hash ([(row y) (in-indexed (port->lines port))]
- [(col x) (in-indexed (string->list row))]
- #:unless (equal? col #\.))
- (define v
- (cond
- [(string->number (string col))]
- [(equal? col #\*) 'gear]
- [else 'other]))
- (values (posn x y) v)))
-
-(define board (~> (open-aoc-input (find-session) 2023 3 #:cache #true) make-board))
-
-(define (posn<? a b)
- (match-define (list (cons (posn a-x a-y) _) (cons (posn b-x b-y) _)) (list a b))
- (if (= a-y b-y) (< a-x b-x) (< a-y b-y)))
-
-(define (find-cells f b)
- (~> (for/hash ([(k v) (in-hash b)] #:when (f v))
- (values k v))
- hash->list
- (sort posn<?)))
-
-(define (group-into-parts cells [acc '()])
- (match* (cells acc)
- [('() acc)
- acc]
- [((list* (cons (and pt (posn x y)) n) cs)
- (list* (part n* (and pts (list* (posn x* y) rest-pts)))
- rest-acc))
- #:when (= (- x x*) 1)
- (group-into-parts cs (cons (part (+ n (* n* 10)) (cons pt pts)) rest-acc))]
- [((list* (cons pt n) cs) acc)
- (group-into-parts cs (cons (part n (list pt)) acc))]))
-
-(define (neighbors p)
- (for*/list ([dx '(-1 0 1)]
- [dy '(-1 0 1)]
- #:unless (and (= dx 0) (= dy 0)))
- (posn (+ dx (posn-x p)) (+ dy (posn-y p)))))
-
-(define to-neighbors (λ~>> part-posns (append-map neighbors) remove-duplicates))
-(define (symbol-in-neighbors b pt acc)
- (~>> pt
- to-neighbors
- (ormap (λ (p) (let ([lookup (hash-ref b p #f)])
- (or (equal? lookup 'gear) (equal? lookup 'other)))))
- ((λ (bool) (if bool (+ acc (part-n pt)) acc)))))
-
-;; part 1
-(define parts (~>> board (find-cells integer?) group-into-parts))
-(foldl (curry symbol-in-neighbors board) 0 parts)
-
-;; part 2
-(define gears (~>> board (find-cells (curry equal? 'gear)) (map car)))
-(define parts-with-neighbors (map (λ (pt) (struct-copy part pt [posns (to-neighbors pt)])) parts))
-
-(define (find-parts-near-gear pts gear)
- (filter-map (λ (pt) (and (findf (curry equal? gear) (part-posns pt)) (part-n pt))) pts))
-
-(~>> gears
- (filter-map (λ~>> (find-parts-near-gear parts-with-neighbors)
- ((λ (ns) (if (= (length ns) 2) (* (first ns) (second ns)) #f)))))
- (apply +))
diff --git a/aoc2023-other/day-04/day-04.rkt b/aoc2023-other/day-04/day-04.rkt
deleted file mode 100644
index 7a357c5..0000000
--- a/aoc2023-other/day-04/day-04.rkt
+++ /dev/null
@@ -1,40 +0,0 @@
-#lang racket
-
-(require advent-of-code
- data/applicative
- data/either
- data/monad
- megaparsack
- megaparsack/text
- threading)
-
-(struct card (n wins))
-
-(define card/p
- (do (string/p "Card")
- (many/p space/p)
- [n <- integer/p]
- (string/p ":")
- (many/p space/p)
- [winners <- (many-until/p integer/p #:sep (many/p space/p) #:end (try/p (string/p " | ")))]
- (many/p space/p)
- [has <- (many+/p integer/p #:sep (many/p space/p))]
- (pure (card n (set-count (set-intersect (first winners) has))))))
-
-(define raw-cards (~> (open-aoc-input (find-session) 2023 4 #:cache #true) port->lines))
-
-;; part 1
-(for/sum ([raw-card (in-list raw-cards)]
- #:do [(match-define (success (card _ wins)) (parse-string card/p raw-card))]
- #:unless (= wins 0))
- (expt 2 (sub1 wins)))
-
-;; part 2
-(for/fold ([counts (for/hash ([n (in-inclusive-range 1 (length raw-cards))])
- (values n 1))]
- #:result (apply + (hash-values counts)))
- ([raw-card (in-list raw-cards)]
- #:do [(match-define (success (card n wins)) (parse-string card/p raw-card))])
- (define bonus-range (inclusive-range (+ n 1) (+ n wins)))
- (define won-cards (hash-ref counts n))
- (foldl (λ (n acc) (hash-update acc n (curry + won-cards))) counts bonus-range))
diff --git a/aoc2023-other/day-05/day-05.rkt b/aoc2023-other/day-05/day-05.rkt
deleted file mode 100644
index 5b9aa52..0000000
--- a/aoc2023-other/day-05/day-05.rkt
+++ /dev/null
@@ -1,91 +0,0 @@
-#lang racket
-
-(require advent-of-code
- algorithms
- threading)
-
-(struct map-range (start end offset))
-(struct seed-range (start end))
-
-(define input (fetch-aoc-input (find-session) 2023 5 #:cache #true))
-
-(match-define (list* raw-seeds raw-mappings) (string-split input "\n\n"))
-
-(define seeds-naive (~> raw-seeds (string-split " ") rest (map string->number _)))
-(define mappers
- (for/list ([raw-mapping (in-list raw-mappings)])
- (for/lists (map-ranges #:result (sort map-ranges < #:key map-range-start))
- ([raw-map-range (in-list (rest (string-split raw-mapping "\n")))]
- #:do [(match-define (list dest source width)
- (~> raw-map-range (string-split _ " ") (map string->number _)))])
- (map-range source (+ source width -1) (- dest source)))))
-
-;; part 1
-(define (in-map-range? n mr)
- (<= (map-range-start mr) n (map-range-end mr)))
-
-(define (transform-value mapper n)
- (match mapper
- ['() n]
- [(list* mr _)
- #:when (in-map-range? n mr)
- (+ n (map-range-offset mr))]
- [(list* _ rest-mapper) (transform-value rest-mapper n)]))
-
-(for/lists (transforms #:result (apply min transforms))
- ([seed (in-list seeds-naive)])
- (foldl transform-value seed mappers))
-
-;; part 2
-(define (remap-range r mapper [acc '()])
- (match-define (seed-range r-start r-end) r)
- (match mapper
- ; mapper exhausted
- ['() (cons r acc)]
- ; range to the left - not covered by this mapping, so keep as-is
- [(list* (map-range m-start _ _) _)
- #:when (< r-end m-start)
- (cons r acc)]
- ; range to the right - move to next map-range
- [(list* (map-range _ m-end _) ms)
- #:when (< m-end r-start)
- (remap-range r ms acc)]
- ; range is inside map-range - transform whole range
- [(list* (map-range m-start m-end offset) _)
- #:when (and (<= m-start r-start) (<= r-end m-end))
- (cons (seed-range (+ r-start offset) (+ r-end offset)) acc)]
- ; range overlaps start only - keep left side, transform right side
- [(list* (map-range m-start m-end offset) ms)
- #:when (and (< r-start m-start) (<= r-end m-end))
- (remap-range (seed-range (add1 m-end) r-end)
- ms
- (cons (seed-range (+ m-start offset) (+ r-end offset)) acc))]
- ; range overlaps end - transform left side, pass right side
- [(list* (map-range m-start m-end offset) ms)
- #:when (and (< m-start r-start) (<= m-end r-end))
- (remap-range (seed-range (add1 m-end) r-end)
- ms
- (cons (seed-range (+ r-start offset) (+ m-end offset)) acc))]
- ; range overlaps whole map-range - keep left side, transform middle, pass right side
- [(list* (map-range m-start m-end offset) ms)
- (remap-range (seed-range (add1 m-end) r-end)
- ms
- (cons (seed-range (+ m-start offset) (+ m-end offset))
- (cons (seed-range (add1 m-end) r-end) acc)))]))
-
-(define (remap-ranges rs mappers)
- (cond
- [(empty? mappers) rs]
- [else
- (~>> rs (append-map (curryr remap-range (first mappers))) (remap-ranges _ (rest mappers)))]))
-
-(~> seeds-naive
- (chunks-of 2)
- (map (λ (xs)
- (match-define (list start width) xs)
- (~> (list (seed-range start (+ start width -1)))
- (remap-ranges mappers)
- (argmin seed-range-start _)))
- _)
- (argmin seed-range-start _)
- seed-range-start)
diff --git a/aoc2023-other/day-06/day-06.rkt b/aoc2023-other/day-06/day-06.rkt
deleted file mode 100644
index 53ca9ee..0000000
--- a/aoc2023-other/day-06/day-06.rkt
+++ /dev/null
@@ -1,32 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading)
-
-(match-define (list times distances)
- (~> (open-aoc-input (find-session) 2023 6 #:cache #true) port->lines))
-
-;; part 1
-(define get-numbers (λ~> string-split (map string->number _) rest))
-(define (find-bound race-time dist button-time step)
- (if (< dist (* button-time (- race-time button-time)))
- button-time
- (find-bound race-time dist (+ step button-time) step)))
-
-(define (lower-bound rtime dist)
- (find-bound rtime dist 1 1))
-(define (upper-bound rtime dist)
- (find-bound rtime dist rtime -1))
-
-(for/fold ([acc 1])
- ([race-time (in-list (get-numbers times))]
- [distance (in-list (get-numbers distances))])
- (* acc (add1 (- (upper-bound race-time distance) (lower-bound race-time distance)))))
-
-;; part 2
-
-(define unkern (λ~>> get-numbers (apply ~a) string->number))
-(define big-time (unkern times))
-(define big-distance (unkern distances))
-
-(add1 (- (upper-bound big-time big-distance) (lower-bound big-time big-distance)))
diff --git a/aoc2023-other/day-07/day-07.rkt b/aoc2023-other/day-07/day-07.rkt
deleted file mode 100644
index 30e629b..0000000
--- a/aoc2023-other/day-07/day-07.rkt
+++ /dev/null
@@ -1,82 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading
- memo)
-
-(struct hand (cards wager))
-
-(define/match (card->int card)
- [((? char-numeric?)) (~> card string string->number)]
- [(#\A) 14]
- [(#\K) 13]
- [(#\Q) 12]
- [(#\J) 11]
- [(#\T) 10]
- [(#\*) 1])
-
-(define (parse-hand str #:jokers [jokers? #f])
- (match-define (list card-str wager-str) (string-split str))
- (define cards
- (~> card-str
- ((λ (str) (if jokers? (string-replace str "J" "*") str)))
- string->list
- (map card->int _)))
- (define wager (~> wager-str string->number))
- (hand cards wager))
-
-(define input (~> (open-aoc-input (find-session) 2023 7 #:cache #true) port->lines))
-
-(define/memoize (identify-hand h)
- (define freqs (~> h hand-cards (sort <) (group-by identity _) (map length _)))
- (match freqs
- [(list-no-order 5) 8]
- [(list-no-order 1 4) 7]
- [(list-no-order 2 3) 6]
- [(list-no-order 1 1 3) 5]
- [(list-no-order 1 2 2) 4]
- [(list-no-order 1 1 1 2) 3]
- [(list-no-order 1 1 1 1 1) 2]
- [_ 1]))
-
-(define (compare-first-card cs1 cs2)
- (if (= (first cs1) (first cs2))
- (compare-first-card (rest cs1) (rest cs2))
- (< (first cs1) (first cs2))))
-
-(define (compare-hands with h1 h2)
- (define rank1 (with h1))
- (define rank2 (with h2))
- (if (= rank1 rank2) (compare-first-card (hand-cards h1) (hand-cards h2)) (< rank1 rank2)))
-
-;; part 1
-
-(define (compare-hands-no-wilds h1 h2)
- (compare-hands identify-hand h1 h2))
-
-(define (total-score in #:jokers [jokers? #false])
- (define sorted-hands
- (~> in
- (map (curry parse-hand #:jokers jokers?) _)
- (sort (if jokers? compare-hands-no-wilds compare-hands-with-wilds))))
- (for/sum ([(h i)
- (in-indexed sorted-hands)])
- (* (add1 i) (hand-wager h))))
-
-(total-score input)
-
-;; part 2
-
-(define/memoize (find-best-joker-substitution h)
- (for/fold ([best-hand (hand '() 0)])
- ([wild (in-inclusive-range 2 14)])
- (define trial-hand
- (hand (map (λ (c) (if (= c 1) wild c)) (hand-cards h)) (hand-wager h)))
- (if (> (identify-hand trial-hand) (identify-hand best-hand))
- trial-hand
- best-hand)))
-
-(define (compare-hands-with-wilds h1 h2)
- (compare-hands (λ~> find-best-joker-substitution identify-hand) h1 h2))
-
-(total-score input #:jokers #true)
diff --git a/aoc2023-other/day-08/day-08.rkt b/aoc2023-other/day-08/day-08.rkt
deleted file mode 100644
index 06daafa..0000000
--- a/aoc2023-other/day-08/day-08.rkt
+++ /dev/null
@@ -1,36 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading)
-
-(struct exits (left right) #:transparent)
-
-(match-define (list raw-directions raw-maze)
- (~> (fetch-aoc-input (find-session) 2023 8 #:cache #true) (string-split "\n\n")))
-
-(define directions (string->list raw-directions))
-
-(define maze
- (for/hash ([line (in-list (string-split raw-maze "\n"))])
- (match (regexp-match #rx"(...) = \\((...), (...)\\)" line)
- [(list _ name left right) (values name (exits left right))])))
-
-(define (to-next-node start end dirs maze)
- (for/fold ([current start]
- [acc 0]
- #:result acc)
- ([dir (in-cycle dirs)])
- #:break (string-suffix? current end)
- (define node (hash-ref maze current))
- (case dir
- [(#\L) (values (exits-left node) (add1 acc))]
- [(#\R) (values (exits-right node) (add1 acc))])))
-
-;; part 1
-(to-next-node "AAA" "ZZZ" directions maze)
-
-;; part 2
-(for/lists (ns #:result (apply lcm ns))
- ([start (in-list (hash-keys maze))]
- #:when (string-suffix? start "A"))
- (to-next-node start "Z" directions maze))
diff --git a/aoc2023-other/day-09/day-09-polynomial.rkt b/aoc2023-other/day-09/day-09-polynomial.rkt
deleted file mode 100644
index 5bacb1f..0000000
--- a/aoc2023-other/day-09/day-09-polynomial.rkt
+++ /dev/null
@@ -1,17 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading
- simple-polynomial/tools)
-
-(define histories
- (for/list ([raw-history (in-lines (open-aoc-input (find-session) 2023 9 #:cache #true))])
- (~>> raw-history
- string-split
- (map string->number))))
-
-(for/lists (left right #:result (cons (apply + left) (apply + right)))
- ([history (in-list histories)])
- (define f (interpolate-at-integer-points history))
- (values (f -1)
- (f (length history))))
diff --git a/aoc2023-other/day-09/day-09.rkt b/aoc2023-other/day-09/day-09.rkt
deleted file mode 100644
index 5eda1eb..0000000
--- a/aoc2023-other/day-09/day-09.rkt
+++ /dev/null
@@ -1,32 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading)
-
-(define histories
- (for/list ([raw-history (in-lines (open-aoc-input (find-session) 2023 9 #:cache #true))])
- (~>> raw-history
- string-split
- (map string->number))))
-
-(define (constant? xs)
- (= 1 (length (remove-duplicates xs))))
-
-(define/match (derivative xs)
- [((list a b)) (list (- b a))]
- [((list* a b _)) (cons (- b a) (derivative (rest xs)))])
-
-(define (extrapolate xs)
- (if (constant? xs)
- (car xs)
- (+ (last xs) (extrapolate (derivative xs)))))
-
-;; part 1
-(~>> histories
- (map extrapolate)
- (apply +))
-
-;; part 2
-(~>> histories
- (map (λ~> reverse extrapolate))
- (apply +))
diff --git a/aoc2023-other/day-10/day-10.rkt b/aoc2023-other/day-10/day-10.rkt
deleted file mode 100644
index 64d8727..0000000
--- a/aoc2023-other/day-10/day-10.rkt
+++ /dev/null
@@ -1,97 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading)
-
-(struct posn (r c) #:transparent)
-
-(define/match (add-posns _p1 _p2)
- [((posn x1 y1) (posn x2 y2)) (posn (+ x1 x2) (+ y1 y2))])
-
-(define go-north (posn -1 0))
-(define go-south (posn 1 0))
-(define go-east (posn 0 1))
-(define go-west (posn 0 -1))
-
-(define initial-directions
- (list (cons go-north '(#\| #\7 #\F))
- (cons go-south '(#\| #\J #\L))
- (cons go-east '(#\- #\J #\7))
- (cons go-west '(#\- #\F #\L))))
-
-(define/match (pipe-neighbors _pipe)
- [(#\|) (list go-north go-south)]
- [(#\-) (list go-east go-west)]
- [(#\L) (list go-north go-east)]
- [(#\F) (list go-south go-east)]
- [(#\7) (list go-south go-west)]
- [(#\J) (list go-north go-west)])
-
-(define (make-pipe-grid in)
- (for*/hash ([(row r) (in-indexed (string-split in "\n"))]
- [(ch c) (in-indexed (string->list row))])
- (values (posn (add1 r) (add1 c)) ch)))
-
-(define (get-valid-S-neighbors S grid)
- (for/list ([dir (in-list initial-directions)]
- #:do [(match-define (cons d valid) dir)]
- #:do [(define neighbor (add-posns d S))]
- #:when (member (hash-ref grid neighbor 'none) valid))
- neighbor))
-
-(define (to-next-pipe current previous grid [acc '()])
- (cond
- [(equal? (hash-ref grid current #f) #\S) acc]
- [else
- (define next
- (for/first ([d (in-list (pipe-neighbors (hash-ref grid current)))]
- #:do [(define neighbor (add-posns d current))]
- #:unless (equal? neighbor previous))
- neighbor))
- (~> next (to-next-pipe _ current grid (cons current acc)))]))
-
-;; part 1
-(define input (fetch-aoc-input (find-session) 2023 10 #:cache #true))
-
-(define pipe-grid (make-pipe-grid input))
-
-(define S-posn
- (for/first ([(k v) (in-hash pipe-grid)] #:when (equal? v #\S))
- k))
-
-(define S-neighbors (get-valid-S-neighbors S-posn pipe-grid))
-
-(define pipe-loop (to-next-pipe (first S-neighbors) S-posn pipe-grid '()))
-
-(/ (add1 (length pipe-loop)) 2)
-
-;; part 2
-(define pipe-loop-set (~> (list->set pipe-loop) (set-add S-posn)))
-
-(define (trace-rays pt pipes grid)
- (cond
- [(set-member? pipes pt) #f]
- [else (odd? (trace-ray pt pipes grid))]))
-
-(define (trace-ray pt pipes grid)
- (define row (posn-r pt))
- (for/fold ([acc 0]
- [corner #f]
- #:result acc)
- ([col (in-naturals (posn-c pt))]
- #:do [(define test-pt (posn row col))]
- #:break (not (hash-has-key? grid test-pt))
- #:when (set-member? pipes test-pt))
- (define pipe (hash-ref grid test-pt))
- (match* (corner pipe)
- [(#f #\|) (values (add1 acc) #f)] ; vertical crossing
- [(#f (or #\F #\L)) (values acc pipe)]
- [(#\F #\J) (values (add1 acc) #f)] ; a ┏━┛ shape counts as a vertical crossing
- [(#\L #\7) (values (add1 acc) #f)]
- [(#\F #\7) (values acc #f)] ; a ┏━┓ shape doesn't count
- [(#\L #\J) (values acc #f)]
- [(_ _) (values acc corner)])))
-
-(~> pipe-grid
- hash-keys
- (count (λ~> (trace-rays pipe-loop-set pipe-grid)) _))
diff --git a/aoc2023-other/day-11/day-11.rkt b/aoc2023-other/day-11/day-11.rkt
deleted file mode 100644
index dba617b..0000000
--- a/aoc2023-other/day-11/day-11.rkt
+++ /dev/null
@@ -1,40 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading)
-
-(struct posn (x y) #:transparent)
-
-(define input
- (~> (fetch-aoc-input (find-session) 2023 11 #:cache #true)
- (string-split "\n")
- (map string->list _)))
-
-(define (get-empty-ranks grid)
- (for/list ([(rank n) (in-indexed grid)] #:when (equal? '(#\.) (remove-duplicates rank)))
- n))
-
-(define (count-prior-empty-ranks rank empty-ranks)
- (~> empty-ranks
- (takef (curryr < rank))
- length))
-
-(define empty-rows (get-empty-ranks input))
-(define empty-columns (get-empty-ranks (apply map list input))) ;; transpose
-
-(define (sum-of-star-distances in expand-by)
- (define stars
- (for*/list ([(row x) (in-indexed in)]
- [(col y) (in-indexed row)]
- #:when (equal? col #\#))
- (posn (+ x (* (sub1 expand-by) (count-prior-empty-ranks x empty-rows)))
- (+ y (* (sub1 expand-by) (count-prior-empty-ranks y empty-columns))))))
- (for/sum ([star-pair (in-combinations stars 2)])
- (match-define (list (posn x1 y1) (posn x2 y2)) star-pair)
- (+ (abs (- x1 x2)) (abs (- y1 y2)))))
-
-;; part 1
-(sum-of-star-distances input 2)
-
-;; part 2
-(sum-of-star-distances input 1000000)
diff --git a/aoc2023-other/day-12/day-12.rkt b/aoc2023-other/day-12/day-12.rkt
deleted file mode 100644
index 50b14bb..0000000
--- a/aoc2023-other/day-12/day-12.rkt
+++ /dev/null
@@ -1,65 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading
- memo)
-
-(struct condition (template spring-set))
-
-(define conditions
- (for/list ([line (in-lines (open-aoc-input (find-session) 2023 12 #:cache #true))])
- (match (string-split line #px"[ ,]")
- [(list* template spring-set)
- (condition (string->list template) (map string->number spring-set))])))
-
-(define/memoize (do-count template spring-group left-in-group need-gap?)
- ;; template: list of spring positions
- ;; spring-group: list of remaining contiguous groups of damaged springs
- ;; left-in-group: springs remaining in current bad spring group being placed
- ;; need-gap?: did we just finish placing a bad spring group
- ;; and need at least one undamaged spring before starting the next one?
- (match* (template spring-group left-in-group need-gap?)
- ;; no springs left to place and no places left to place springs
- ;; this is an OK arrangement, count it
- [('() '() 0 _) 1]
- ;; ambiguous wildcard, try both skipping this spot and starting a damaged spring group here
- [((list* #\? t-rest) (list* g g-rest) 0 #f)
- (+ (do-count t-rest g-rest (sub1 g) (= g 1))
- (do-count t-rest spring-group 0 #f))]
- ;; definitely a place for a good spring (.), move on without consuming any spring groups
- [((list* #\? t-rest) '() 0 #f) ; good spring, no more damaged springs to place
- (do-count t-rest spring-group 0 #f)]
- [((list* #\? t-rest) _ 0 #t) ; good spring right after finishing a group of bad springs
- (do-count t-rest spring-group 0 #f)]
- [((list* #\. t-rest) _ 0 _) ; known good spring
- (do-count t-rest spring-group 0 #f)]
- ;; start of bad spring (#) group, use the next spring group and remove 1 from it
- [((list* #\# t-rest) (list* g g-rest) 0 #f) (do-count t-rest g-rest (sub1 g) (= g 1))]
- ;; continuation of bad spring group, same
- [((list* (or #\? #\#) t-rest) g left #f) (do-count t-rest g (sub1 left) (= left 1))]
- ;; if nothing above works, this arrangement's invalid
- [(_ _ _ _) 0]))
-
-(define (count-solutions c)
- (match-define (condition template spring-set) c)
- (do-count template spring-set 0 #f))
-
-;; part 1
-(for/sum ([c (in-list conditions)])
- (count-solutions c))
-
-;; part 2
-(define expanded-conditions
- (for/list ([c (in-list conditions)])
- (condition (~> c
- condition-template
- (make-list 5 _)
- (add-between #\?)
- flatten)
- (~> c
- condition-spring-set
- (make-list 5 _)
- flatten))))
-
-(for/sum ([c* (in-list expanded-conditions)])
- (count-solutions c*))
diff --git a/aoc2023-other/day-13/day-13.rkt b/aoc2023-other/day-13/day-13.rkt
deleted file mode 100644
index 47718f8..0000000
--- a/aoc2023-other/day-13/day-13.rkt
+++ /dev/null
@@ -1,47 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading)
-
-(define input
- (~>(fetch-aoc-input (find-session) 2023 13 #:cache #true)
- (string-split "\n\n")
- (map (λ~> string-split) _)))
-
-(define (do-symmetric? lefts rights errs)
- (cond
- [(empty? rights) #f]
- [else
- (define found-errs
- (for/sum ([l (in-string (string-join lefts ""))]
- [r (in-string (string-join rights ""))]
- #:unless (char=? l r))
- 1))
- (if (= errs found-errs)
- (length lefts)
- (do-symmetric? (cons (first rights) lefts)
- (rest rights)
- errs))]))
-
-(define (symmetric? xss errs)
- (do-symmetric? (list (first xss)) (rest xss) errs))
-
-(define (transpose strs)
- (~> strs
- (map string->list _)
- (apply map list _)
- (map list->string _)))
-
-(define (find-symmetry-score xss errs)
- (cond
- [(symmetric? xss errs) => (curry * 100)]
- [else (symmetric? (transpose xss) errs)]))
-
-;; part 1
-(for/sum ([note (in-list input)])
- (find-symmetry-score note 0))
-
-;; part 2
-(for/sum ([note (in-list input)])
- (find-symmetry-score note 1))
-
diff --git a/aoc2023-other/day-14/day-14.rkt b/aoc2023-other/day-14/day-14.rkt
deleted file mode 100644
index d0b7cad..0000000
--- a/aoc2023-other/day-14/day-14.rkt
+++ /dev/null
@@ -1,49 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading
- "../../jj-aoc.rkt")
-
-(define input
- (~> (fetch-aoc-input (find-session) 2023 14 #:cache #true)
- string-split
- (map string->list _)
- transpose))
-
-(define (roll-boulders board)
- (for/list ([col (in-list board)])
- (~> col (chunks-by (curry equal? #\#)) (append-map (curryr sort char>?) _))))
-
-(define (score board)
- (for*/sum ([col (in-list board)]
- [(row n) (in-indexed (reverse col))]
- #:when (equal? row #\O))
- (add1 n)))
-
-;; part 1
-(~> input
- roll-boulders
- score)
-
-;; part 2
-(define (rotate-board xss)
- (~> xss
- (map reverse _)
- transpose))
-
-(define (full-cycle board)
- (foldl (λ (_ acc) (~> acc roll-boulders rotate-board)) board (range 4)))
-
-(define (spin-to-win board)
- (define cache (make-hash))
- (define (do-spin board n)
- (match (hash-ref cache board 'not-found)
- ['not-found
- (hash-set! cache board n)
- (do-spin (full-cycle board) (sub1 n))]
- [seen
- (define to-end (modulo n (- seen n)))
- (score (foldl (λ (_ acc) (full-cycle acc)) board (range to-end)))]))
- (do-spin board 1000000000))
-
-(~> input spin-to-win)
diff --git a/aoc2023-other/day-15/day-15.rkt b/aoc2023-other/day-15/day-15.rkt
deleted file mode 100644
index d049565..0000000
--- a/aoc2023-other/day-15/day-15.rkt
+++ /dev/null
@@ -1,41 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading)
-
-(define input
- (~> (fetch-aoc-input (find-session) 2023 15 #:cache #true) string-trim (string-split ",")))
-
-(define (hash-algorithm str)
- (for/fold ([acc 0]) ([c (in-string str)])
- (~> c char->integer (+ acc) (* 17) (modulo _ 256))))
-
-;; part 1
-(for/sum ([code (in-list input)]) (hash-algorithm code))
-
-;; part 2
-(define (remove-lens boxes label)
- (hash-update boxes
- (hash-algorithm label)
- (λ (lens-set) (remove label lens-set (λ (rem l) (equal? rem (car l)))))
- '()))
-
-(define (insert-lens boxes label focal)
- (define new-lens (cons label focal))
- (hash-update boxes
- (hash-algorithm label)
- (λ (lens-set)
- (if (assoc label lens-set)
- (map (λ (pair) (if (equal? (car pair) label) new-lens pair)) lens-set)
- (append lens-set (list new-lens))))
- (list new-lens)))
-
-(define (focusing-power boxes)
- (for*/sum ([(box-number lenses) (in-hash boxes)] [(lens order) (in-indexed lenses)])
- (* (add1 box-number) (add1 order) (cdr lens))))
-
-(for/fold ([boxes (hash)] #:result (focusing-power boxes)) ([code (in-list input)])
- (match code
- [(regexp #rx"(.*)=(.*)" (list _ label (app string->number focal)))
- (insert-lens boxes label focal)]
- [(regexp #rx"(.*)-" (list _ label)) (remove-lens boxes label)]))
diff --git a/aoc2023-other/day-16/day-16.rkt b/aoc2023-other/day-16/day-16.rkt
deleted file mode 100644
index 4a70de8..0000000
--- a/aoc2023-other/day-16/day-16.rkt
+++ /dev/null
@@ -1,70 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading)
-
-(struct posn (r c) #:transparent)
-(struct light (posn dir) #:transparent)
-
-(define input (fetch-aoc-input (find-session) 2023 16 #:cache #true))
-
-(define grid
- (for*/hash ([(row r) (in-indexed (string-split input "\n"))]
- [(cell c) (in-indexed (in-string row))])
- (values (posn r c) cell)))
-
-(define/match (move _l)
- [((light (posn r c) 'up)) (light (posn (sub1 r) c) 'up)]
- [((light (posn r c) 'right)) (light (posn r (add1 c)) 'right)]
- [((light (posn r c) 'left)) (light (posn r (sub1 c)) 'left)]
- [((light (posn r c) 'down)) (light (posn (add1 r) c) 'down)])
-
-(define/match (transform l _cell)
- [(_ #\.) l]
- [(_ 'off) '()]
-
- [((light _ (or 'up 'down)) #\|) l]
- [((light _ (or 'left 'right)) #\-) l]
-
- [((light p 'left) #\/) (light p 'down)]
- [((light p 'down) #\/) (light p 'left)]
- [((light p 'right) #\/) (light p 'up)]
- [((light p 'up) #\/) (light p 'right)]
-
- [((light p 'left) #\\) (light p 'up)]
- [((light p 'up) #\\) (light p 'left)]
- [((light p 'right) #\\) (light p 'down)]
- [((light p 'down) #\\) (light p 'right)]
-
- [((light p (or 'left 'right)) #\|) (list (light p 'up) (light p 'down))]
- [((light p (or 'up 'down)) #\-) (list (light p 'left) (light p 'right))])
-
-;; part 1
-(define (get-energized start)
- (for/fold ([energized (set)]
- [previously-visited (set)]
- [beam-tips (set start)]
- #:result (set-count energized))
- ([_ (in-naturals)])
- (define next-positions
- (list->set
- (flatten (for/list ([b (in-set beam-tips)])
- (~> b move ((λ (b) (transform b (hash-ref grid (light-posn b) 'off)))))))))
- (define all-visited (set-union previously-visited next-positions))
- (define next-energized (set-union energized (list->set (set-map next-positions light-posn))))
- #:break (equal? previously-visited all-visited)
- (values next-energized all-visited (set-subtract next-positions previously-visited))))
-
-(get-energized (light (posn 0 -1) 'right))
-
-;; part 2
-(define rows (~> input (string-split "\n") length))
-(define cols (~> input (string-split #rx"\n.*") first string-length))
-
-(define all-starting-positions
- (append (map (λ (r) (light (posn r -1) 'right)) (range rows))
- (map (λ (r) (light (posn r cols) 'left)) (range rows))
- (map (λ (c) (light (posn -1 c) 'down)) (range cols))
- (map (λ (c) (light (posn rows c) 'up)) (range cols))))
-
-(get-energized (argmax get-energized all-starting-positions)) \ No newline at end of file
diff --git a/aoc2023-other/day-17/day-17.rkt b/aoc2023-other/day-17/day-17.rkt
deleted file mode 100644
index 05709ad..0000000
--- a/aoc2023-other/day-17/day-17.rkt
+++ /dev/null
@@ -1,86 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading
- data/heap)
-
-(struct state (p heat-lost previous history))
-(struct posn (r c))
-
-(define/match (add _p1 _p2)
- [((posn r1 c1) (posn r2 c2)) (posn (+ r1 r2) (+ c1 c2))])
-
-(define deltas (list (posn 0 1) (posn 0 -1) (posn 1 0) (posn -1 0)))
-
-(define input (fetch-aoc-input (find-session) 2023 17 #:cache #true))
-
-(define grid
- (for*/hash ([(row r) (in-indexed (in-list (string-split input "\n")))]
- [(col c) (in-indexed (in-string row))])
- (values (posn r c) (~> col string string->number))))
-
-(define goal-posn (~>> grid hash-keys (argmax (λ (p) (+ (posn-r p) (posn-c p))))))
-
-(define (make-key s)
- (cons (state-p s) (same-dir s)))
-
-(define (goal? n s)
- (and (equal? goal-posn (state-p s))
- (>= (length (same-dir s)) n)))
-
-(define (same-dir s)
- (define history (state-history s))
- (if (empty? history)
- '()
- (takef history (λ (n) (equal? n (car history))))))
-
-(define (find-good-neighbors min-dist max-dist s)
- (match-define (state p hl prev hist) s)
-
- (define (eliminate-bad-neighbors delta)
- (define neighbor (add p delta))
- (cond
- [(or (equal? neighbor prev) (not (hash-has-key? grid neighbor))) #false]
- [else
- (define same (same-dir s))
- (define l (length same))
- (cond
- [(= max-dist l) (not (equal? delta (car same)))]
- [(= l 0) #true]
- [(< l min-dist) (equal? delta (car same))]
- [else #t])]))
-
- (define (make-state delta)
- (define neighbor (add p delta))
- (define new-loss (+ hl (hash-ref grid neighbor)))
- (state neighbor new-loss p (cons delta hist)))
-
- (~>> deltas (filter eliminate-bad-neighbors) (map make-state)))
-
-(define (find-path neighbor-fn goal-fn)
- (define seen (mutable-set))
- (define queue (make-heap (λ (a b) (<= (state-heat-lost a) (state-heat-lost b)))))
- (heap-add! queue (state (posn 0 0) 0 'none '()))
-
- (let bfs ()
- (define s (heap-min queue))
- (heap-remove-min! queue)
- (define key (make-key s))
- (cond
- [(set-member? seen key) (bfs)]
- [else
- (set-add! seen key)
- (define neighbors (neighbor-fn s))
- (define final (findf goal-fn neighbors))
- (if final
- (state-heat-lost final)
- (begin
- (for ([n (in-list neighbors)])
- (heap-add! queue n))
- (bfs)))])))
-
-;; part 1
-(find-path (curry find-good-neighbors 0 3) (curry goal? 1))
-
-;; part 2
-(find-path (curry find-good-neighbors 4 10) (curry goal? 4)) \ No newline at end of file
diff --git a/aoc2023-other/day-18/day-18.rkt b/aoc2023-other/day-18/day-18.rkt
deleted file mode 100644
index b589e41..0000000
--- a/aoc2023-other/day-18/day-18.rkt
+++ /dev/null
@@ -1,48 +0,0 @@
-#lang racket
-(require advent-of-code
- threading)
-
-(struct coord (x y))
-
-(define input (~> (fetch-aoc-input (find-session) 2023 18 #:cache #true)))
-
-(define (go-to-next-coord c dir dist)
- (match-define (coord x y) c)
- (match dir
- [(or "R" "0") (coord (+ x dist) y)]
- [(or "D" "1") (coord x (- y dist))]
- [(or "L" "2") (coord (- x dist) y)]
- [(or "U" "3") (coord x (+ y dist))]))
-
-(define/match (triangle-area _coord1 _coord2)
- [((coord x1 y1) (coord x2 y2)) (/ (- (* x1 y2) (* x2 y1)) 2)])
-
-(define (find-area-using parser)
- (for/fold ([area 0]
- [perimeter 0]
- [current-coord (coord 0 0)]
- #:result (+ 1 (abs area) (/ perimeter 2)))
- ([dig (in-list (string-split input "\n"))])
- (define-values (dir dist) (parser dig))
- (define next-coord (go-to-next-coord current-coord dir dist))
- (values (+ area (triangle-area current-coord next-coord))
- (+ perimeter dist) next-coord)))
-
-;; part 1
-(define (parse-front dig)
- (match-define (regexp #rx"(.) (.*) \\((.*)\\)"
- (list _ dir (app string->number dist) _hex))
- dig)
- (values dir dist))
-
-(find-area-using parse-front)
-
-;; part 2
-
-(define (parse-hex dig)
- (match-define (regexp #rx".*\\(#(.....)(.)\\)"
- (list _ (app (curryr string->number 16) dist) dir))
- dig)
- (values dir dist))
-
-(find-area-using parse-hex)
diff --git a/aoc2023-other/day-19/day-19.rkt b/aoc2023-other/day-19/day-19.rkt
deleted file mode 100644
index f7561f6..0000000
--- a/aoc2023-other/day-19/day-19.rkt
+++ /dev/null
@@ -1,134 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading
- data/applicative
- data/monad
- megaparsack
- megaparsack/text
- racket/struct)
-
-(struct part (x m a s))
-(struct rule (rating comparison threshold action))
-(struct just (action))
-(struct interval (from to))
-
-(match-define (list raw-workflows raw-parts)
- (~> (fetch-aoc-input (find-session) 2023 19 #:cache #true)
- (string-split "\n\n")
- (map (curryr string-split "\n") _)))
-
-(define/match (to-getter _)
- [(#\x) part-x]
- [(#\m) part-m]
- [(#\a) part-a]
- [(#\s) part-s])
-
-(define/match (to-comp _)
- [(#\>) >]
- [(#\<) <])
-
-(define/match (to-action _)
- [('(#\R)) 'reject]
- [('(#\A)) 'accept]
- [(name) (apply string name)])
-
-(define rule/p
- (do (or/p
- (try/p (do [rating <- (char-in/p "xmas")]
- [comparison <- (char-in/p "<>")]
- [threshold <- integer/p]
- (char/p #\:)
- [action <- (many+/p letter/p)]
- (pure (rule (to-getter rating)
- (to-comp comparison)
- threshold
- (to-action action)))))
- (do [name <- (many+/p letter/p)] (pure (just (to-action name)))))))
-(define rules/p
- (do [name <- (many+/p letter/p)]
- (char/p #\{)
- [rules <- (many+/p rule/p #:sep (char/p #\,))]
- (char/p #\})
- (pure (cons (list->string name) rules))))
-
-(define rating/p (do letter/p (char/p #\=) integer/p))
-(define parts/p
- (do (string/p "{")
- [ratings <- (many/p rating/p #:sep (char/p #\,) #:min 4 #:max 4)]
- (string/p "}")
- (pure (apply part ratings))))
-
-(define workflows
- (~>> raw-workflows
- (map (λ~>> (parse-string rules/p) parse-result!))
- make-immutable-hash))
-(define parts (map (λ~>> (parse-string parts/p) parse-result!) raw-parts))
-
-;; part 1
-
-(define (evaluate-workflow p [workflow-name "in"])
- (define rules (hash-ref workflows workflow-name))
- (match (evaluate-rules p rules)
- ['accept (~> p struct->list (apply + _))]
- ['reject 0]
- [name (evaluate-workflow p name)]))
-
-(define (evaluate-rules p rules)
- (match rules
- [(list* (just action) _) action]
- [(list* (rule rating comparison threshold action) _)
- #:when (comparison (rating p) threshold)
- action]
- [(list* _ tail) (evaluate-rules p tail)]))
-
-(for/sum ([p (in-list parts)]) (evaluate-workflow p))
-
-;; part 2
-
-(define (part-update-range pr rating i)
- (match rating
- [(== part-x) (struct-copy part pr (x i))]
- [(== part-m) (struct-copy part pr (m i))]
- [(== part-a) (struct-copy part pr (a i))]
- [(== part-s) (struct-copy part pr (s i))]))
-
-(define (evaluate-workflow-on-range pr [workflow-name "in"])
- (define rules (hash-ref workflows workflow-name))
- (evaluate-rules-on-range pr rules))
-
-(define (evaluate-rules-on-range pr rules)
- (match rules
- [(list* (just 'accept) _)
- (~> pr struct->list
- (map (λ (i) (add1 (- (interval-to i) (interval-from i)))) _)
- (apply * _))]
- [(list* (just 'reject) _) 0]
- [(list* (just name) _) (evaluate-workflow-on-range pr name)]
- [(list* (rule rating (== <) threshold action) tail)
- (match-define (interval i-min i-max) (rating pr))
- (split-range pr
- rating
- (interval i-min (sub1 threshold))
- action
- (interval threshold i-max)
- tail)]
- [(list* (rule rating (== >) threshold action) tail)
- (match-define (interval i-min i-max) (rating pr))
- (split-range pr
- rating
- (interval (add1 threshold) i-max)
- action
- (interval i-min threshold)
- tail)]))
-
-(define (split-range pr rating keep action pass rules)
- (+ (evaluate-rules-on-range (part-update-range pr rating keep)
- (list (just action)))
- (evaluate-rules-on-range (part-update-range pr rating pass)
- rules)))
-
-(define start-interval (interval 1 4000))
-
-(evaluate-workflow-on-range
- (part start-interval start-interval start-interval start-interval))
diff --git a/aoc2023-other/day-20/day-20.rkt b/aoc2023-other/day-20/day-20.rkt
deleted file mode 100644
index 2e3852d..0000000
--- a/aoc2023-other/day-20/day-20.rkt
+++ /dev/null
@@ -1,144 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading
- data/applicative
- data/monad
- megaparsack
- megaparsack/text)
-
-(struct broadcaster ())
-(struct flipflop (state received))
-(struct conjunction (recieved))
-(struct cable (type dests))
-(struct nothing ())
-
-(define charlist->symbol (λ~>> (apply string) string->symbol))
-
-(define input (fetch-aoc-input (find-session) 2023 20 #:cache true))
-
-(define module/p
- (do (or/p (do (char/p #\%)
- [name <- (many+/p letter/p)]
- (pure (cons (charlist->symbol name) (flipflop 'off '()))))
- (do (char/p #\&)
- [name <- (many+/p letter/p)]
- (pure (cons (charlist->symbol name) (conjunction (hash)))))
- (do [name <- (many+/p letter/p)]
- (pure (cons (charlist->symbol name) (broadcaster)))))))
-
-(define cable/p
- (do [mod <- module/p]
- (string/p " -> ")
- [names <- (many/p (many+/p letter/p) #:sep (string/p ", "))]
- (pure (cable mod (map charlist->symbol names)))))
-
-(define cables (~> input (string-split "\n") (map (λ~>> (parse-string cable/p) parse-result!) _)))
-
-(define destinations
- (for/hash ([cable (in-list cables)])
- (values (car (cable-type cable)) (cable-dests cable))))
-
-(define (set-conjunction-initial-state c)
- (cond
- [(conjunction? (cdr c))
- (~>> destinations
- hash-keys
- (filter (λ (k) (member (car c) (hash-ref destinations k))))
- (map (λ (k) (cons k 'low)))
- (make-immutable-hash)
- conjunction
- (cons (car c)))]
- [else c]))
-
-(define (make-initial-conditions-hash cables)
- (~>> cables
- (map cable-type)
- (map set-conjunction-initial-state)
- make-immutable-hash))
-
-(define (receive mod from tone)
- (match mod
- [(flipflop state queue) (flipflop state (append queue (list tone)))]
- [(conjunction received) (conjunction (hash-set received from tone))]
- [(nothing) (nothing)]))
-
-; needed for part 2
-(define to-rx '(rk cd zf qx))
-(define sentry-tones (make-hash (for/list ([node to-rx]) (cons node 0))))
-
-(define (press-button-once current-state this-round)
- (for/fold ([queue '(broadcaster)]
- [all-cables-state current-state]
- [high 0]
- [low 0]
- #:result (values all-cables-state high low))
- ([_i (in-naturals)] #:break (empty? queue))
- (match-define (list* hd tl) queue)
- (define to (hash-ref destinations hd (nothing)))
- (match (hash-ref all-cables-state hd)
- [(broadcaster)
- (define state*
- (foldl (λ (r acc) (hash-update acc r (λ~> (receive hd 'low)) (nothing)))
- all-cables-state
- to))
- (values (hash-ref destinations 'broadcaster) state* high (+ (length to) (add1 low)))]
- [(flipflop 'off (list* 'low q))
- (define state*
- (~> all-cables-state
- (foldl (λ (r acc)
- (when (member r to-rx)
- (println (~a r " received high tone at " this-round)))
- (hash-update acc r (λ~> (receive hd 'high)) (nothing)))
- _
- to)
- (hash-set _ hd (flipflop 'on q))))
- (values (append tl to) state* (+ (length to) high) low)]
- [(flipflop 'on (list* 'low q))
- (define state*
- (~> all-cables-state
- (foldl (λ (r acc) (hash-update acc r (λ~> (receive hd 'low)) (nothing))) _ to)
- (hash-set _ hd (flipflop 'off q))))
- (values (append tl to) state* high (+ (length to) low))]
- [(flipflop on-or-off (list* 'high q))
- (define state* (~> all-cables-state (hash-set _ hd (flipflop on-or-off q))))
- (values tl state* high low)]
- [(conjunction received)
- #:when (or (empty? (hash-values received)) (member 'low (hash-values received)))
-
- (when (member hd to-rx)
- (hash-set! sentry-tones hd this-round))
- (define state*
- (foldl (λ (r acc)
- (hash-update acc r (λ~> (receive hd 'high)) (nothing)))
- all-cables-state
- to))
- (values (append to tl) state* (+ (length to) high) low)]
- [(conjunction _)
- (define state*
- (foldl (λ (r acc) (hash-update acc r (λ~> (receive hd 'low)) (nothing)))
- all-cables-state
- to))
- (values (append tl to) state* high (+ (length to) low))]
- [(nothing) (values tl all-cables-state high low)])))
-
-;; part 1
-(for/fold ([starting-state (make-initial-conditions-hash cables)]
- [high 0]
- [low 0]
- #:result (* high low))
- ([i (in-range 1000)])
- (define-values (next-state this-high this-low) (press-button-once starting-state i))
- (values next-state (+ high this-high) (+ low this-low)))
-
-;; part 2
-;; rx receives a tone from gh, which receives four tones itself
-;; those tones arrive on regular synced cycles so it's just the LCM of those cycle lengths
-;; and since those cycle lengths are prime, it reduces to the product of the lengths
-;; this is a really hacky mutable solution, I'm sure there's better ways of flagging these cycles
-
-(for/fold ([starting-state (make-initial-conditions-hash cables)]
- #:result (apply * (hash-values sentry-tones)))
- ([i (in-range 1 5000)])
- (define-values (next-state _high _low) (press-button-once starting-state i))
- (values next-state)) \ No newline at end of file
diff --git a/aoc2023-other/day-21/day-21.rkt b/aoc2023-other/day-21/day-21.rkt
deleted file mode 100644
index b5478eb..0000000
--- a/aoc2023-other/day-21/day-21.rkt
+++ /dev/null
@@ -1,69 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading
- simple-polynomial
- racket/hash)
-
-(define input (fetch-aoc-input (find-session) 2023 21 #:cache #true))
-
-(define initial-garden
- (~> (for*/list ([(row r) (in-indexed (string-split input "\n"))]
- [(col c) (in-indexed row)]
- #:unless (equal? col #\#))
- (cons (cons r c) (if (equal? col #\S) 'on 'off)))
- make-hash))
-
-(define (neighbors p)
- (match-define (cons r c) p)
- (list (cons (add1 r) c) (cons (sub1 r) c) (cons r (add1 c)) (cons r (sub1 c))))
-
-(define (make-n-steps garden n)
- (define g (hash-copy garden))
- (define (make-one-step)
- (define update (make-hash))
- (for ([(cons state) (in-hash g)] #:when (equal? state 'on))
- (hash-set! update cons 'off)
- (for ([neighbor (in-list (neighbors cons))] #:when (hash-has-key? g neighbor))
- (hash-set! update neighbor 'on)))
- (hash-union! g update #:combine/key (λ (_k _v v) v)))
- (for/fold ([_ void]
- #:result (~>> g hash-values (count (curry equal? 'on))))
- ([i (in-range n)])
- (displayln i)
- (make-one-step)))
-
-;; part 1
-(make-n-steps initial-garden 64)
-
-;; part 2
-;; the growth of the steps pattern is regular and quadratic
-;; the rock pattern has aisles in it that allow the steps pattern to expand freely
-;; such that it will cross from one side to another in X steps
-;; where X is the height/width of the repeated section
-
-(define grid-size (~> input (string-split "\n") length))
-(define half-size (/ (sub1 grid-size) 2))
-
-(define expanded-garden
- (~> (for*/list (#:do [(define rows (string-split input "\n"))]
- #:do [(define height (length rows))]
- [(row r) (in-indexed rows)]
- #:do [(define width (string-length row))]
- [(col c) (in-indexed row)]
- #:unless (equal? col #\#)
- [n (in-inclusive-range -3 3)]
- [m (in-inclusive-range -3 3)])
-
- (cons (cons (+ r (* n height)) (+ c (* m width)))
- (if (and (= n m 0) (equal? col #\S)) 'on 'off)))
- make-hash))
-
-(define fitting-points
- (for/list ([n (in-range 3)] #:do [(define size (+ half-size (* n grid-size)))])
- (cons n (make-n-steps expanded-garden size))))
-
-(define end-cycle 26501365)
-(define x (/ (- end-cycle half-size) grid-size))
-
-((points->polynomial fitting-points) x) \ No newline at end of file
diff --git a/aoc2023-other/day-22/day-22.rkt b/aoc2023-other/day-22/day-22.rkt
deleted file mode 100644
index 53668c0..0000000
--- a/aoc2023-other/day-22/day-22.rkt
+++ /dev/null
@@ -1,109 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading
- data/applicative
- data/monad
- megaparsack
- megaparsack/text
- racket/hash)
-
-(struct posn (x y z))
-(struct block (n from to))
-
-(define input (fetch-aoc-input (find-session) 2023 22 #:cache #true))
-
-(define coordinate/p
- (do [coords <- (many/p integer/p #:sep (char/p #\,) #:min 3 #:max 3)]
- (pure (apply posn coords))))
-
-(define block/p
- (do [from <- coordinate/p]
- (char/p #\~)
- [to <- coordinate/p]
- (pure (cons from to))))
-
-(define starting-blocks
- (~> (for/list ([line (in-list (string-split input "\n"))]
- [n (in-naturals)])
- (match-define (cons from to) (parse-result! (parse-string block/p line)))
- (block n from to))
- (sort < #:key (λ~> block-from posn-z))))
-
-(define (all-in-cross-section-at-level b z)
- (match-define (block _ (posn x1 y1 _) (posn x2 y2 _)) b)
- (for*/list ([x (in-inclusive-range x1 x2)]
- [y (in-inclusive-range y1 y2)])
- (posn x y z)))
-
-(define (place-block-at-level b h dz)
- (match-define (block n (posn x1 y1 z1) (posn x2 y2 z2)) b)
- (define now-occupied
- (for*/hash ([x (in-inclusive-range x1 x2)]
- [y (in-inclusive-range y1 y2)]
- [z (in-inclusive-range dz (+ dz (- z2 z1)))])
- (values (posn x y z) n)))
- (hash-union h now-occupied))
-
-(define (find-lowest-level b h [z (~> b block-from posn-z)])
- (cond
- [(= z 0)
- (place-block-at-level b h 1)]
- [(findf (curry hash-has-key? h) (all-in-cross-section-at-level b z))
- (place-block-at-level b h (add1 z))]
- [else
- (find-lowest-level b h (sub1 z))]))
-
-(define blocks-in-space (foldl find-lowest-level (hash) starting-blocks))
-(define block-positions
- (for/fold ([placed-blocks (hash)])
- ([(p n) (in-hash blocks-in-space)])
- (hash-update placed-blocks n (curryr set-add p) (set))))
-
-(define (down-one p)
- (match p
- [(posn x y z) (posn x y (sub1 z))]))
-
-(define supporting-blocks
- (for/hash ([(n-id n-posns) (in-hash block-positions)])
- (values n-id
- (for*/set ([(m-id m-posns) (in-hash block-positions)]
- #:unless (= n-id m-id)
- [m-posn (in-set m-posns)]
- #:when (set-member? n-posns (down-one m-posn)))
- m-id))))
-
-(define supported-by-blocks
- (for/hash ([n-id (in-hash-keys supporting-blocks)])
- (define supporters
- (~> (for*/set
- ([(m-id m-supporting) (in-hash supporting-blocks)]
- #:unless (= n-id m-id)
- #:when (set-member? m-supporting n-id))
- m-id)
- ((λ (s) (if (set-empty? s) (set 'ground) s)))))
- (values n-id supporters)))
-
-;; part 1
-(define vulnerable-blocks
- (for/list ([n-id (in-range (length starting-blocks))]
- #:when (for/or ([m-supported-by (in-hash-values supported-by-blocks)])
- (set-empty? (set-remove m-supported-by n-id))))
- n-id))
-(- (length starting-blocks) (length vulnerable-blocks))
-
-;; part 2
-(for/sum ([n (in-list vulnerable-blocks)])
- (for/fold ([fallen (set n)]
- [bricks (set n)]
- #:result (~> fallen set-count sub1))
- ([_ (in-naturals)])
- #:break (set-empty? bricks)
- (define bricks-above
- (for*/set
- ([brick (in-set bricks)]
- [supporting (in-set (hash-ref supporting-blocks brick))]
- #:when (for/and ([supports (in-set (hash-ref supported-by-blocks supporting))])
- (set-member? fallen supports)))
- supporting))
- (values (set-union fallen bricks-above) bricks-above))) \ No newline at end of file
diff --git a/aoc2023-other/day-23/day-23.rkt b/aoc2023-other/day-23/day-23.rkt
deleted file mode 100644
index c048013..0000000
--- a/aoc2023-other/day-23/day-23.rkt
+++ /dev/null
@@ -1,89 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading
- graph)
-
-(define input (fetch-aoc-input (find-session) 2023 23 #:cache #true))
-(define trails
- (for*/hash ([(row r) (in-indexed (string-split input "\n"))]
- [(col c) (in-indexed row)]
- #:when (not (equal? col #\#)))
- ; for now, we don't actually need to detect paths and slopes, just not-rocks
- ; in part 1, all forks in the road go right or down, so we can just infer the path
- ; direction from the shape of the junction and form a network of junctions from there
- ; in part 2, the slopes are removed anyway
- (values (cons (add1 r) (add1 c)) col)))
-
-(define max-row (~> input (string-split "\n") length))
-
-(define start (findf (λ (p) (= (car p) 1)) (hash-keys trails)))
-(define end (findf (λ (p) (= (car p) max-row)) (hash-keys trails)))
-
-(define (get-neighbors posn type)
- (match-define (cons r c) posn)
- (match type
- ['junction
- (~> (set (cons (add1 r) c) (cons r (add1 c))))]
- [_
- (~> (list (cons (add1 r) c) (cons (sub1 r) c) (cons r (add1 c)) (cons r (sub1 c)))
- (filter (curry hash-has-key? trails) _)
- list->set)]))
-
-(define junction-points
- (for/set ([(k v) (in-hash trails)]
- #:when (not (= (set-count (get-neighbors k v)) 2)))
- k))
-
-(define trails-with-junctions
- (for/hash ([k (in-hash-keys trails)])
- (cond
- [(set-member? junction-points k) (values k 'junction)]
- [else (values k 'trail)])))
-
-(define (walk-to-next-junction start current [length 1] [seen (set start)])
- (define next (~> current
- (get-neighbors _ 'trail)
- (set-subtract seen) set-first))
- (cond
- [(equal? (hash-ref trails-with-junctions next) 'junction)
- (list (- (add1 length)) start next)] ; weird format is due to graph library
- [else
- (walk-to-next-junction start next (add1 length) (set-add seen current))]))
-
-(define routes-to-junctions
- (for*/list ([j (in-set junction-points)]
- [neighbor (in-set (get-neighbors j 'junction))]
- #:when (hash-has-key? trails neighbor))
- (walk-to-next-junction j neighbor)))
-
-;; part 1 -- using graph library for Bellman-Ford on negative weighted graph
-;; Bellman-Ford finds the shortest path, but negating all the path weights
-;; will give us the longest path instead
-;;
-;; unlike Dijkstra which can't handle negative path lengths, Bellman-Ford
-;; works as long as the graph is currently directed and acyclic
-(define slippery-trail (weighted-graph/directed routes-to-junctions))
-(match-define-values (distances _) (bellman-ford slippery-trail start))
-(- (hash-ref distances end))
-
-;; part 2 -- rolling my own DFS that can reject seen junctions and dead ends
-(define routes-to-junctions-with-traction
- (for/fold ([trails (hash)]) ([route (in-list routes-to-junctions)])
- (match-define (list (app - weight) from to) route)
- (~> trails
- (hash-update _ from (curry cons (cons to weight)) '())
- (hash-update _ to (curry cons (cons from weight)) '()))))
-
-(define (dfs g from to [acc 0] [seen (set from)])
- (cond
- [(equal? from to) acc]
- [else
- (define choices (filter (λ (path) (not (set-member? seen (car path)))) (hash-ref g from)))
- (if (empty? choices) 0 ; long dead-ends don't count
- (for/fold ([best acc])
- ([path (in-list choices)]
- #:do [(match-define (cons next dist) path)])
- (max best (dfs g next to (+ acc dist) (set-add seen next)))))]))
-
-(dfs routes-to-junctions-with-traction start end) \ No newline at end of file
diff --git a/aoc2023-other/day-24/day-24a.rkt b/aoc2023-other/day-24/day-24a.rkt
deleted file mode 100644
index 31f526d..0000000
--- a/aoc2023-other/day-24/day-24a.rkt
+++ /dev/null
@@ -1,51 +0,0 @@
-#lang rosette
-
-(require advent-of-code
- threading)
-
-(struct hail (posn vel) #:transparent)
-(struct posn (x y z) #:transparent)
-(struct vel (x y z) #:transparent)
-
-(define input (fetch-aoc-input (find-session) 2023 24 #:cache #true))
-
-(define LOWER-BOUND 200000000000000)
-(define UPPER-BOUND 400000000000000)
-
-(define (->struct f str)
- (~> str (string-split _ ",") (map (λ~> string-trim string->number) _) (apply f _)))
-
-(define (parse-hail-record str)
- (match-define (list p v) (string-split str " @ "))
- (hail (->struct posn p)
- (->struct vel v)))
-
-(define hail-paths
- (for/list ([hail (in-list (string-split input "\n"))])
- (parse-hail-record hail)))
-
-;; part 1
-(define (valid-intersection? h1 h2)
- (match-define (hail (posn x1 y1 _) (vel vx1 vy1 _)) h1)
- (match-define (hail (posn x2 y2 _) (vel vx2 vy2 _)) h2)
- (cond
- [(= (* vy1 vx2) (* vx1 vy2)) #f]
- [else
- (define t1 (/ (- (* vy2 (- x1 x2)) (* vx2 (- y1 y2)))
- (- (* vy1 vx2) (* vx1 vy2))))
- (define t2 (/ (- (* vy1 (- x2 x1)) (* vx1 (- y2 y1)))
- (- (* vy2 vx1) (* vx2 vy1))))
-
- (define x (+ x1 (* t1 vx1)))
- (define y (+ y1 (* t1 vy1)))
-
- (and (<= LOWER-BOUND x UPPER-BOUND)
- (<= LOWER-BOUND y UPPER-BOUND)
- (<= 0 t1)
- (<= 0 t2))]))
-
-(for/sum ([(trial-paths) (in-combinations hail-paths 2)] ;
- #:when (apply valid-intersection? trial-paths))
- 1)
-
-;; part 2 - see day-24b.rkt
diff --git a/aoc2023-other/day-24/day-24b.rkt b/aoc2023-other/day-24/day-24b.rkt
deleted file mode 100644
index b106b30..0000000
--- a/aoc2023-other/day-24/day-24b.rkt
+++ /dev/null
@@ -1,37 +0,0 @@
-#lang rosette
-
-(require advent-of-code
- threading)
-
-(struct hail (posn vel))
-(struct posn (x y z))
-(struct vel (x y z))
-
-(define input (fetch-aoc-input (find-session) 2023 24 #:cache #true))
-
-(define (->struct f str)
- (~> str (string-split _ ",") (map (λ~> string-trim string->number) _) (apply f _)))
-
-(define (parse-hail-record str)
- (match-define (list p v) (string-split str " @ "))
- (hail (->struct posn p) (->struct vel v)))
-
-(define hail-paths
- (for/list ([hail (in-list (string-split input "\n"))] ;
- [_ (in-range 3)])
- (parse-hail-record hail)))
-
-;; part 1 - see day-24a.rkt
-;; part 2
-
-(define-symbolic px py pz vx vy vz integer?)
-
-(define sol
- (solve ;
- (for ([path (in-list hail-paths)])
- (define-symbolic* t integer?)
- (assert (= (+ px (* vx t)) (+ (~> path hail-posn posn-x) (* (~> path hail-vel vel-x) t))))
- (assert (= (+ py (* vy t)) (+ (~> path hail-posn posn-y) (* (~> path hail-vel vel-y) t))))
- (assert (= (+ pz (* vz t)) (+ (~> path hail-posn posn-z) (* (~> path hail-vel vel-z) t)))))))
-
-(evaluate (+ px py pz) sol)
diff --git a/aoc2023-other/day-25/day-25.rkt b/aoc2023-other/day-25/day-25.rkt
deleted file mode 100644
index aa32e43..0000000
--- a/aoc2023-other/day-25/day-25.rkt
+++ /dev/null
@@ -1,43 +0,0 @@
-#lang racket
-
-(require advent-of-code
- threading
- graph)
-
-(define input
- (~> (fetch-aoc-input (find-session) 2023 25 #:cache #true)
- (string-split "\n")
- (map (curryr string-split ": ") _)))
-
-(define all-wires
- (for*/list ([wire-diagram (in-list input)] [devices (in-list (string-split (second wire-diagram)))])
- (list (car wire-diagram) devices)))
-
-;; instead of trying to solve the minimum cut problem, I generated the graph and
-;; rendered it in graphviz:
-
-; (define out (open-output-file "graphviz"))
-; (~> all-wires
-; unweighted-graph/undirected
-; graphviz
-; (display out))
-; (close-output-port out)
-
-;; the bottleneck is very obvious on the graph --
-;; there's two large clusters of nodes, connected by just three edges
-;;
-;; from the graphviz output, the three critical wires are
-;; cpq-hlx
-;; hqp-spk
-;; chr-zlx
-
-(define remove-these-three '(("cpq" "hlx") ("hqp" "spk") ("chr" "zlx")))
-(define cut-wires
- (for/list ([wire (in-list all-wires)] #:unless (member (sort wire string<?) remove-these-three))
- wire))
-
-(~> cut-wires
- unweighted-graph/undirected
- scc
- (map length _)
- (apply * _)) \ No newline at end of file