From 8777ff071f7bb37631baa7b6717ad29961e50911 Mon Sep 17 00:00:00 2001
From: "H.J" <thechairman@thechairman.info>
Date: Wed, 9 Oct 2024 11:36:55 -0400
Subject: sorting by language

---
 racket/aoc2022/day-23/day-23.rkt | 76 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 76 insertions(+)
 create mode 100644 racket/aoc2022/day-23/day-23.rkt

(limited to 'racket/aoc2022/day-23')

diff --git a/racket/aoc2022/day-23/day-23.rkt b/racket/aoc2022/day-23/day-23.rkt
new file mode 100644
index 0000000..6069859
--- /dev/null
+++ b/racket/aoc2022/day-23/day-23.rkt
@@ -0,0 +1,76 @@
+#lang racket
+
+(require advent-of-code
+         fancy-app
+         threading)
+
+(struct posn (x y) #:transparent)
+
+(define initial-map
+  (for*/hash ([(row y) (in-indexed (in-lines (open-aoc-input (find-session) 2022 23 #:cache #true)))]
+              [(col x) (in-indexed row)]
+              #:when (equal? col #\#))
+    (values (posn x y) #t)))
+
+(define/match (neighbors-in direction p)
+  [('north (posn x (app sub1 y*))) (list (posn (sub1 x) y*) (posn x y*) (posn (add1 x) y*))]
+  [('south (posn x (app add1 y*))) (list (posn (sub1 x) y*) (posn x y*) (posn (add1 x) y*))]
+  [('east (posn (app add1 x*) y)) (list (posn x* (add1 y)) (posn x* y) (posn x* (sub1 y)))]
+  [('west (posn (app sub1 x*) y)) (list (posn x* (add1 y)) (posn x* y) (posn x* (sub1 y)))])
+
+(define/match (move-to direction p)
+  [('stay p) p]
+  [('north (posn x y)) (posn x (sub1 y))]
+  [('south (posn x y)) (posn x (add1 y))]
+  [('east (posn x y)) (posn (add1 x) y)]
+  [('west (posn x y)) (posn (sub1 x) y)])
+
+(define (propose-movements elves dirs)
+  (for/hash ([(elf _) (in-hash elves)])
+    (define dir-candidates
+      (for/list ([dir dirs]
+                 #:do [(define neighbors (neighbors-in dir elf))]
+                 #:unless (ormap (curry hash-has-key? elves) neighbors))
+        dir))
+    (define chosen-dir
+      (match dir-candidates
+        ['() 'stay]
+        [(== dirs) 'stay]
+        [(cons dir _) dir]))
+    (values elf chosen-dir)))
+
+(define (try-proposed-movements elves)
+  (define moved-elves (make-hash))
+  (for ([(elf dir) (in-hash elves)])
+    (hash-update! moved-elves (move-to dir elf) (cons elf _) '()))
+  (define reconciled-elves (make-hash))
+  (for ([(posn elves) (in-hash moved-elves)])
+    (match elves
+      ; if there's only one elf at a coordinate, leave it there
+      [(list _) (hash-set! reconciled-elves posn #t)]
+      ; if there's many elves at one coordinate, back them up to their previous spot
+      [many-elves
+       (for ([elf (in-list many-elves)])
+         (hash-set! reconciled-elves elf #t))]))
+  reconciled-elves)
+
+;; part 1
+(define (count-empty-spots elves)
+  (define elf-posns (hash-keys elves))
+  (match-define (list x-min _ ... x-max) (sort (map posn-x elf-posns) <))
+  (match-define (list y-min _ ... y-max) (sort (map posn-y elf-posns) <))
+  (for*/sum ([y (inclusive-range y-min y-max)] [x (inclusive-range x-min x-max)])
+            (if (hash-has-key? elves (posn x y)) 0 1)))
+
+(for/fold ([elves initial-map] [dirs '(north south west east)] #:result (count-empty-spots elves))
+          ([_rnd (in-range 10)])
+  (values (~> elves (propose-movements dirs) try-proposed-movements)
+          (append (cdr dirs) (list (car dirs)))))
+
+;; part 2
+(for/fold ([elves initial-map] [dirs '(north south west east)] [rnd 1] #:result rnd)
+          ([_rnd (in-naturals)])
+  (define elves-proposed (propose-movements elves dirs))
+  ; elves have stopped moving if they all conclude they want to stay put
+  #:break (~> elves-proposed hash-values remove-duplicates (equal? '(stay)))
+  (values (try-proposed-movements elves-proposed) (append (cdr dirs) (list (car dirs))) (add1 rnd)))
-- 
cgit v1.2.3