Merge branch 'main' of https://github.com/hunkyjimpjorps/AdventOfCode

2 files changed, 92 insertions, 0 deletions

diff --git a/2022/day-13/day-13.rkt b/2022/day-13/day-13.rkt
new file mode 100644
index 0000000..d4e3185
--- /dev/null
+++ b/2022/day-13/day-13.rkt
@@ -0,0 +1,28 @@
+#lang racket
+
+(require advent-of-code)
+
+(define raw-packets
+  (parameterize ([current-readtable (make-readtable #f #\, #\space #f)])
+    (port->list read (open-aoc-input (find-session) 2022 13 #:cache #true))))
+
+(define (compare xs ys)
+  (match* (xs ys)
+    [('() (list* _)) #true]
+    [((list* _) '()) #false]
+    [((list* a x-rest) (list* a y-rest)) (compare x-rest y-rest)]
+    [((list* (? integer? x) _) (list* (? integer? y) _)) (< x y)]
+    [((list* (? list? xs*) _) (list* (? list? ys*) _)) (compare xs* ys*)]
+    [((list* (? list?) _) (list* (? integer? y) y-rest)) (compare xs (cons (list y) y-rest))]
+    [((list* (? integer? x) x-rest) (list* (? list?) _)) (compare (cons (list x) x-rest) ys)]))
+
+;; part 1
+(for/sum ([i (in-naturals 1)] [packet (in-slice 2 raw-packets)] #:when (apply compare packet)) i)
+
+;; part 2
+(define divider-packets (list '((2)) '((6))))
+(define amended-packets (append divider-packets raw-packets))
+
+(for/product ([i (in-naturals 1)] [packet (in-list (sort amended-packets compare))]
+                                  #:when (member packet divider-packets))
+             i)
diff --git a/2022/day-14/day-14.rkt b/2022/day-14/day-14.rkt
new file mode 100644
index 0000000..7950339
--- /dev/null
+++ b/2022/day-14/day-14.rkt
@@ -0,0 +1,64 @@
+#lang racket
+
+(require advent-of-code
+         threading
+         algorithms)
+
+(define data (fetch-aoc-input (find-session) 2022 14 #:cache #true))
+
+(define (trace-line-between-points p1 p2)
+  (match* (p1 p2)
+    [((list x y1) (list x y2))
+     (for/list ([y [in-inclusive-range (min y1 y2) (max y1 y2)]])
+       (cons x y))]
+    [((list x1 y) (list x2 y))
+     (for/list ([x [in-inclusive-range (min x1 x2) (max x1 x2)]])
+       (cons x y))]))
+
+(define all-coordinates
+  (apply append
+         (for/list ([formation (in-list (string-split data "\n"))])
+           (define coord-list
+             (for/list ([coord-pair (in-list (string-split formation " -> "))])
+               (for/list ([coord (in-list (string-split coord-pair ","))])
+                 (string->number coord))))
+           (apply append (adjacent-map trace-line-between-points coord-list)))))
+
+(define rock-structures-hash
+  (for/hash ([p (in-list all-coordinates)])
+    (values p 'rock)))
+
+(define max-vertical-distance (~>> all-coordinates (argmax cdr) cdr add1))
+
+(define (open? h x y)
+  (not (hash-has-key? h (cons x y))))
+
+;; part 1
+(define (trace-grain h [pos (cons 500 0)])
+  (match-define (cons x y) pos)
+  (cond
+    [(> y max-vertical-distance) 'break]
+    [(open? h x (add1 y)) (trace-grain h (cons x (add1 y)))]
+    [(open? h (sub1 x) (add1 y)) (trace-grain h (cons (sub1 x) (add1 y)))]
+    [(open? h (add1 x) (add1 y)) (trace-grain h (cons (add1 x) (add1 y)))]
+    [else (hash-set h (cons x y) 'sand)]))
+
+(for/fold ([h rock-structures-hash] [grains 0] #:result grains) ([_ (in-naturals 1)])
+  (define h* (trace-grain h))
+  #:break (eq? h* 'break)
+  (values h* (add1 grains)))
+
+;; part 2
+(define (trace-grain* h [pos (cons 500 0)])
+  (match-define (cons x y) pos)
+  (cond
+    [(= y max-vertical-distance) (hash-set h (cons x y) 'sand)]
+    [(open? h x (add1 y)) (trace-grain* h (cons x (add1 y)))]
+    [(open? h (sub1 x) (add1 y)) (trace-grain* h (cons (sub1 x) (add1 y)))]
+    [(open? h (add1 x) (add1 y)) (trace-grain* h (cons (add1 x) (add1 y)))]
+    [else (hash-set h (cons x y) 'sand)]))
+
+(for/fold ([h rock-structures-hash] [grains 0] #:result grains) ([_ (in-naturals 1)])
+  #:break (not (open? h 500 0))
+  (define h* (trace-grain* h))
+  (values h* (add1 grains)))