From 4ebdb400b0ab49a3769dd85a1d08788a683c7d90 Mon Sep 17 00:00:00 2001
From: rhiannon morris <rhi@rhiannon.website>
Date: Sat, 2 Dec 2023 14:21:00 +0100
Subject: [PATCH] day 2 scheme

---
 day2.ss | 101 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 101 insertions(+)
 create mode 100644 day2.ss

diff --git a/day2.ss b/day2.ss
new file mode 100644
index 0000000..326db2b
--- /dev/null
+++ b/day2.ss
@@ -0,0 +1,101 @@
+(import (rnrs))
+
+(define-syntax curry
+  (syntax-rules ()
+    [(_ f x ...) (lambda (y) (f x ... y))]))
+
+(define (mapmap f lst) (map (curry map f) lst))
+
+(define (split-at ch str)
+  (let [(len (string-length str))]
+    (let loop [(start 0) (end 0) (acc '())]
+      (cond
+        [(>= start len)
+         (reverse (if (= start end) (cons "" acc) acc))]
+        [(>= end len)
+         (reverse (cons (substring str start len) acc))]
+        [(char=? ch (string-ref str end))
+         (loop (+ end 1) (+ end 1) (cons (substring str start end) acc))]
+        [else (loop start (+ end 1) acc)]))))
+
+(define (trim str)
+  (let loop [(i 0)]
+    (if (char-whitespace? (string-ref str i))
+      (loop (+ i 1))
+      (let loop [(j (- (string-length str) 1))]
+        (if (char-whitespace? (string-ref str j))
+          (loop (- j 1))
+          (substring str i (+ j 1)))))))
+
+(define (one-col str)
+  (let* [(str (trim str))
+         (words (split-at #\space str))]
+    (cons (string->symbol (cadr words)) (string->number (car words)))))
+
+(define (split-line line)
+  (let* [(line (split-at #\: line))
+         (id (car line)) (line (cadr line))
+         (id (string->number (cadr (split-at #\space id))))
+         (draws (split-at #\; line))
+         (colours (map (curry split-at #\,) draws))
+         (pairs (mapmap one-col colours))]
+    (cons id pairs)))
+
+(define (max-count col)
+  (case col [(red) 12] [(green) 13] [(blue) 14]))
+
+
+(define-syntax case-list
+  (syntax-rules (nil cons)
+    [(_ lst [nil n ...] [(cons x xs) c ...])
+     (if (null? lst)
+       (begin n ...)
+       (let [(x (car lst)) (xs (cdr lst))] c ...))]
+    [(_ lst [(cons x xs) c ...] [nil n ...])
+     (case-list lst [nil n ...] [(cons x xs) c ...])]))
+
+(define-syntax let-pair
+  (syntax-rules ()
+    [(_ [(x y) pair] body ...)
+     (let [(x (car pair)) (y (cdr pair))] body ...)]))
+
+(define (valid-draw draws)
+  (case-list draws
+    [nil #t]
+    [(cons this rest)
+     (let-pair [(col count) this]
+       (if (<= count (max-count col)) (valid-draw rest) #f))]))
+
+(define (valid line)
+  (let-pair [(id draws) line]
+    (if (for-all valid-draw draws) id #f)))
+
+(define (read-file path)
+  (let* [(str (call-with-input-file path get-string-all))]
+    (map split-line
+         (filter (lambda (s) (not (string=? s "")))
+                 (split-at #\newline str)))))
+
+(define (total lines)
+  (apply + (map (lambda (line) (or (valid line) 0)) lines)))
+
+(define input (read-file "in/day2"))
+
+(define (part1) (total input))
+
+(display (cons "part1" (part1))) (newline)
+
+(define (min-cubes draws)
+  (fold-left
+    (lambda (a b)
+      (let* [(get (lambda (col draw) (cond [(assq col draw) => cdr] [else 0])))
+             (get-max (lambda (c) (cons c (max (get c a) (get c b)))))]
+        (list (get-max 'red) (get-max 'green) (get-max 'blue))))
+    '() draws))
+
+(define (power line)
+  (fold-left (lambda (n c) (* n (cdr c))) 1 (min-cubes (cdr line))))
+
+(define (part2) (apply + (map power input)))
+
+(display (cons "part2" (part2))) (newline)