Add day 05 - 2024HEADmaster

2 files changed, 166 insertions, 0 deletions

diff --git a/2024/aoc-utils.scm b/2024/aoc-utils.scm
index 9f22c47..99e086a 100644
--- a/2024/aoc-utils.scm
+++ b/2024/aoc-utils.scm
@@ -8,6 +8,7 @@
             file->str
             file->matrix
             lines->number-list
+            element-index
 
             <matrix>
             matrix
@@ -49,6 +50,10 @@
       (set! retval (cons i retval)))
     retval))
 
+(define (element-index e lst)
+    (cond [(eqv? e (car lst)) 0]
+          [else (+ (element-index e (cdr lst)) 1)]))
+
 ;; Matrix utilities
 
 (define-record-type <matrix>
diff --git a/2024/day05/main.scm b/2024/day05/main.scm
new file mode 100755
index 0000000..ce850cb
--- /dev/null
+++ b/2024/day05/main.scm
@@ -0,0 +1,161 @@
+#!/usr/bin/guile -s
+!#
+
+(add-to-load-path (format #f "~a/2024" (getcwd)))
+;(add-to-load-path (format #f "~a/.." (dirname (current-filename))))
+
+(use-modules
+ (aoc-utils)
+ ; lists
+ (srfi srfi-1)
+ ; Multiple values
+ (srfi srfi-8)
+ (srfi srfi-9)
+ (srfi srfi-64)
+ (ice-9 regex)
+ (ice-9 getopt-long))
+
+;; utility function
+
+(define (split-input lines)
+  (let ((rules '())
+        (pages '()))
+    (for-each (lambda (line)
+           (cond ((string-contains line "|") (set! rules (cons line rules)))
+                 ((string-contains line ",") (set! pages (cons line pages)))))
+         lines)
+    (list rules pages)))
+
+(define (parse-rules lines)
+  (map (lambda (line)
+         (map string->number (string-split line #\|)))
+       lines))
+
+(define (parse-pages lines)
+  (map (lambda (line)
+         (map string->number (string-split line #\,)))
+       lines))
+
+(define (split-pages-at pages idx)
+  (receive (pre post) (split-at pages idx)
+    (values pre (cdr post))))
+
+;; Part 1
+
+(define (valid-pages-before? number lst rules)
+  (= (length (filter (lambda (pair)
+                (and (= number (second pair))
+                     (member (first pair) lst)))
+              rules))
+     (length lst)))
+
+(define (valid-pages-after? number lst rules)
+  (= (length (filter (lambda (pair)
+                (and (= number (first pair))
+                     (member (second pair) lst)))
+              rules))
+     (length lst)))
+
+(define (right-order? page pages rules)
+  (let ((idx (element-index page pages)))
+    (receive (pre post) (split-pages-at pages idx)
+      (cond ((not (valid-pages-before? page pre rules)) #f)
+            ((not (valid-pages-after? page post rules)) #f)
+            (else #t)))))
+
+(define (good-page-order pages rules)
+  "pages are a list of numbers."
+  (if (every (lambda (e) (eq? e #t))
+             (map (lambda (page)
+                    (right-order? page pages rules))
+                  pages))
+      pages
+      #f))
+
+(define (middle-element lst)
+  (let ((idx (quotient (length lst) 2)))
+    (list-ref lst idx)))
+
+(define (part1 input)
+  (let* ((parts (split-input input))
+         (rules (parse-rules (first parts)))
+         (pages (parse-pages (second parts)))
+         (good-pages (map (lambda (pages-order) (good-page-order pages-order rules)) pages)))
+    (apply + (filter-map (lambda (good-page) (if good-page
+                                                 (middle-element good-page)
+                                                 #f))
+                         good-pages))))
+
+;; Part 2
+(define (bad-page-order pages rules)
+  "pages are a list of numbers."
+  (if (every (lambda (e) (eq? e #t))
+             (map (lambda (page)
+                    (right-order? page pages rules))
+                  pages))
+      #f
+      pages))
+
+(define (bad-pages pages rules)
+  (filter (lambda (page-list) (bad-page-order page-list rules)) pages))
+
+(define (find-rule e1 e2 rules)
+  "Return a matching rule for e1 and e2"
+  (filter (lambda (pair)
+            (and (= (first pair) e1)
+                 (= (second pair) e2)))
+          rules))
+
+(define (rule-compare e1 e2 rules)
+  "Return less of e1 e2 acording to matching rules."
+  (if (> (length (find-rule e1 e2 rules)) 0)
+      #t
+      #f))
+
+(define (sort-by-rules lst rules)
+  (sort lst (lambda (e1 e2) (rule-compare e1 e2 rules))))
+
+(define (part2 input)
+  (let* ((parts (split-input input))
+         (rules (parse-rules (first parts)))
+         (pages (parse-pages (second parts))))
+    (apply + (map (lambda (lst) (middle-element lst))
+                  (map (lambda (lst) (sort-by-rules lst rules)) (bad-pages pages rules))))))
+
+;; Tests
+
+(define (run-tests)
+  "")
+
+;; Main
+
+(define option-spec
+  '((help (single-char #\h) (value #f))
+    (test (single-char #\t) (value #f))))
+
+(define (help)
+  (display "main.scm [options] [FILE]
+-h, --help   Display this help.
+-t, --test   Run test suite
+"))
+
+(define (run-parts filename)
+  (let ((input (file->list filename)))
+    (display "Part1: ")
+    (display (part1 input))
+    (newline)
+    (display "Part2: ")
+    (display (part2 input))
+    (newline)))
+
+(define (main)
+  (let* ((options (getopt-long (command-line) option-spec))
+         (help-wanted? (option-ref options 'help #f))
+         (test-wanted? (option-ref options 'test #f))
+         (files (option-ref options '() '())))
+    (cond (help-wanted? (help))
+          (test-wanted? (run-tests))
+          ((= (length files) 1) (run-parts (car files)))
+          (else (help)))))
+
+(main)