Add day 04 of 2024

1 files changed, 77 insertions, 15 deletions

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)