2 files changed, 95 insertions, 17 deletions
diff --git a/aoc2023-other/day-02/day-02-parser.rkt b/aoc2023-other/day-02/day-02-parser.rkt
index 67f5ae6..76cc24f 100644
--- a/aoc2023-other/day-02/day-02-parser.rkt
+++ b/aoc2023-other/day-02/day-02-parser.rkt
@@ -13,33 +13,43 @@
 
 (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))))
+    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)))))
+  (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 (max-cubes all-draws))
-      (pure (game id (hash-ref maxima "red") (hash-ref maxima "green") (hash-ref maxima "blue")))))
-
-(define (max-cubes h)
-  (foldl (curry hash-union #:combine max) (hash "red" 0 "green" 0 "blue" 0) h))
+    [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))))
+       (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))
+(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)))
+(for/sum ([m (in-list game-maxima)])
+  (* (game-r m) (game-g m) (game-b m)))
diff --git a/aoc2023-other/day-03/day-03.rkt b/aoc2023-other/day-03/day-03.rkt
new file mode 100644
index 0000000..d52b11b
--- /dev/null
+++ b/aoc2023-other/day-03/day-03.rkt
@@ -0,0 +1,68 @@
+#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
+  (~>> parts (map (λ (pt) (struct-copy part pt [posns (to-neighbors pt)])))))
+
+(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 +))