Add day 04 of 2024

3 files changed, 161 insertions, 16 deletions

diff --git a/2024/aoc-utils.scm b/2024/aoc-utils.scm
index ed16bfd..9f22c47 100644
--- a/2024/aoc-utils.scm
+++ b/2024/aoc-utils.scm
@@ -1,12 +1,25 @@
 (define-module (aoc-utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 rdelim)
   #:export (file->list
             file->str
             file->matrix
-            lines->number-list))
+            lines->number-list
+
+            <matrix>
+            matrix
+            make-matrix
+            matrix-inner
+            matrix-width
+            matrix-height
+            matrix-ref
+            matrix-valid-x?
+            matrix-valid-y?
+            matrix-valid-point?
+            list-flatten))
 
 (define (file->list filename)
   (let ((lines (string-split (call-with-input-file filename read-string) #\Newline)))
@@ -35,3 +48,36 @@
         ((< i 0))
       (set! retval (cons i retval)))
     retval))
+
+;; Matrix utilities
+
+(define-record-type <matrix>
+  (matrix inner width height)
+  matrix?
+  (inner matrix-inner)
+  (width matrix-width)
+  (height matrix-height))
+
+(define (make-matrix lst)
+  (let ((height (length lst))
+        (width (length (car lst))))
+    (matrix (list-flatten lst) width height)))
+
+(define (list-flatten lst)
+  (apply append lst))
+
+(define (matrix-ref matrix x y)
+  (if (matrix-valid-point? matrix x y)
+      (list-ref (matrix-inner matrix)
+                (+ x (* y (matrix-height matrix))))
+      #f))
+
+(define (matrix-valid-x? matrix x)
+  (and (>= x 0) (< x (matrix-width matrix))))
+
+(define (matrix-valid-y? matrix y)
+  (and (>= y 0) (< y (matrix-height matrix))))
+
+(define (matrix-valid-point? matrix x y)
+  (and (matrix-valid-x? matrix x)
+       (matrix-valid-y? matrix y)))
diff --git a/2024/day04/main.scm b/2024/day04/main.scm
index 026e795..292ca38 100755
--- a/2024/day04/main.scm
+++ b/2024/day04/main.scm
@@ -2,7 +2,7 @@
 !#
 
 (add-to-load-path (format #f "~a/2024" (getcwd)))
-(add-to-load-path (format #f "~a/.." (dirname (current-filename))))
+;(add-to-load-path (format #f "~a/.." (dirname (current-filename))))
 
 (use-modules
  (aoc-utils)
@@ -16,22 +16,84 @@
   (or (equal? lst '(#\X #\M #\A #\S))
       (equal? lst '(#\S #\A #\M #\X))))
 
-(define (get-posibilities input x y)
-  (let ((retval '()))
-    (if (> x (- (length input) 3))
-        (set! retval ()))))
+(define (check-south matrix x y)
+  (let ((to-check (list (matrix-ref matrix x y)
+                        (matrix-ref matrix x (+ 1 y))
+                        (matrix-ref matrix x (+ 2 y))
+                        (matrix-ref matrix x (+ 3 y)))))
+    (xmas? to-check)))
 
-(define (part1 input)
-  (display input)
-  0)
+(define (check-east matrix x y)
+  (let ((to-check (list (matrix-ref matrix x y)
+                        (matrix-ref matrix (+ 1 x) y)
+                        (matrix-ref matrix (+ 2 x) y)
+                        (matrix-ref matrix (+ 3 x) y))))
+    (xmas? to-check)))
 
-(define (part2 input)
-  0)
+(define (check-south-east matrix x y)
+  (let ((to-check (list (matrix-ref matrix x y)
+                        (matrix-ref matrix (+ 1 x) (+ 1 y))
+                        (matrix-ref matrix (+ 2 x) (+ 2 y))
+                        (matrix-ref matrix (+ 3 x) (+ 3 y)))))
+    (xmas? to-check)))
 
-(define (run-tests)
-  (test-begin "day03" 1)
-  (test-equal 18 (part1 (file->matrix "test.txt")))
-  (test-end "day03"))
+(define (check-south-west matrix x y)
+  (let ((to-check (list (matrix-ref matrix x y)
+                        (matrix-ref matrix (- x 1) (+ 1 y))
+                        (matrix-ref matrix (- x 2) (+ 2 y))
+                        (matrix-ref matrix (- x 3) (+ 3 y)))))
+    (xmas? to-check)))
+
+(define (part1 matrix)
+  (let ((retval 0))
+    (do ((x 0 (1+ x)))
+        ((> x (1- (matrix-width matrix))))
+      (do ((y 0 (1+ y)))
+          ((> y (1- (matrix-height matrix))))
+        (if (check-south matrix x y)
+            (set! retval (1+ retval)))
+        (if (check-east matrix x y)
+            (set! retval (1+ retval)))
+        (if (check-south-east matrix x y)
+            (set! retval (1+ retval)))
+        (if (check-south-west matrix x y)
+            (set! retval (1+ retval)))))
+    retval))
+
+;; Part 2
+
+(define (x-mas? lst1 lst2)
+  (or (and (equal? lst1 '(#\M #\A #\S))
+           (equal? lst2 '(#\M #\A #\S)))
+
+      (and (equal? lst1 '(#\S #\A #\M))
+           (equal? lst2 '(#\S #\A #\M)))
+
+      (and (equal? lst1 '(#\S #\A #\M))
+           (equal? lst2 '(#\M #\A #\S)))
+
+      (and (equal? lst1 '(#\M #\A #\S))
+           (equal? lst2 '(#\S #\A #\M)))))
+
+(define (check-cross matrix x y)
+  (let ((diagonal1 (list (matrix-ref matrix (- x 1) (- y 1))
+                         (matrix-ref matrix x y)
+                         (matrix-ref matrix (+ x 1) (+ y 1))))
+        (diagonal2 (list (matrix-ref matrix (+ x 1) (- y 1))
+                         (matrix-ref matrix x y)
+                         (matrix-ref matrix (- x 1) (+ y 1)))))
+    (x-mas? diagonal1 diagonal2)))
+
+(define (part2 matrix)
+  (let ((retval 0))
+    (do ((x 0 (1+ x)))
+        ((> x (1- (matrix-width matrix))))
+      (do ((y 0 (1+ y)))
+          ((> y (1- (matrix-height matrix))))
+        (if (equal? (matrix-ref matrix x y) #\A)
+            (if (check-cross matrix x y)
+                (set! retval (1+ retval))))))
+    retval))
 
 (define option-spec
   '((help (single-char #\h) (value #f))
@@ -44,7 +106,7 @@
 "))
 
 (define (run-parts filename)
-  (let ((input (file->matrix filename)))
+  (let ((input (make-matrix (file->matrix filename))))
     (display "Part1: ")
     (display (part1 input))
     (newline)
diff --git a/2024/tests.scm b/2024/tests.scm
new file mode 100644
index 0000000..f09a92c
--- /dev/null
+++ b/2024/tests.scm
@@ -0,0 +1,37 @@
+;(add-to-load-path "2024/")
+(use-modules (aoc-utils)
+             (srfi srfi-64))
+
+(test-begin "aoc-utils")
+
+(test-group "matrix"
+  (define test-lst '((1 2 3)
+                     (4 5 6)
+                     (7 8 9)))
+
+  (test-equal (list-flatten test-lst) '(1 2 3 4 5 6 7 8 9))
+
+  (define m (make-matrix test-lst))
+
+  (test-equal (matrix-inner m) (list-flatten test-lst))
+  (test-equal (matrix-width m) 3)
+  (test-equal (matrix-height m) 3)
+
+  (test-equal (matrix-ref m 0 0) 1)
+  (test-equal (matrix-ref m 1 1) 5)
+  (test-equal (matrix-ref m 2 2) 9)
+
+  (test-assert (matrix-valid-x? m 0))
+  (test-assert (matrix-valid-x? m 1))
+  (test-assert (matrix-valid-x? m 2))
+  (test-assert (not (matrix-valid-x? m 3)))
+  (test-assert (not (matrix-valid-x? m -1)))
+
+  (test-assert (matrix-valid-y? m 0))
+  (test-assert (matrix-valid-y? m 1))
+  (test-assert (matrix-valid-y? m 2))
+  (test-assert (not (matrix-valid-y? m 3)))
+  (test-assert (not (matrix-valid-y? m -1)))
+  )
+
+(test-end "aoc-utils")