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/aoc2023/day-02/day-02-parser.rkt | 55 +++++++++++++++++++++++++++++++++
 racket/aoc2023/day-02/day-02.rkt        | 35 +++++++++++++++++++++
 2 files changed, 90 insertions(+)
 create mode 100644 racket/aoc2023/day-02/day-02-parser.rkt
 create mode 100644 racket/aoc2023/day-02/day-02.rkt

(limited to 'racket/aoc2023/day-02')

diff --git a/racket/aoc2023/day-02/day-02-parser.rkt b/racket/aoc2023/day-02/day-02-parser.rkt
new file mode 100644
index 0000000..76cc24f
--- /dev/null
+++ b/racket/aoc2023/day-02/day-02-parser.rkt
@@ -0,0 +1,55 @@
+#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/racket/aoc2023/day-02/day-02.rkt b/racket/aoc2023/day-02/day-02.rkt
new file mode 100644
index 0000000..973d20c
--- /dev/null
+++ b/racket/aoc2023/day-02/day-02.rkt
@@ -0,0 +1,35 @@
+#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)))
-- 
cgit v1.2.3