Refactor Guile version of day 04

1 files changed, 27 insertions, 30 deletions

diff --git a/day04.scm b/day04.scm
index a65a300..fc4a4f4 100644
--- a/day04.scm
+++ b/day04.scm
@@ -2,7 +2,8 @@
   #:use-module (ice-9 rdelim)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
-  #:use-module (srfi srfi-41))
+  #:use-module (srfi srfi-41)
+  #:use-module (util))
 
 (define* (read-input #:optional (port (current-input-port)))
   (define (read-lines acc)
@@ -15,12 +16,13 @@
   (list->typed-array 'u8 2 (map string->char-codes strings)))
 
 (define xmas (map char->integer (string->list "XMAS")))
+(define directions '((-1 -1) (-1 0) (-1 1) (0 -1) (0 1) (1 -1) (1 0) (1 1)))
 
-(define (start-word? arr i j di dj)
-  (let loop ((i i) (j j) (lst xmas))
+(define (start-word? arr pt di dj)
+  (let loop ((pt pt) (lst xmas))
     (or (null-list? lst)
-        (and (= (array-ref arr i j) (first lst))
-             (loop (+ i di) (+ j dj) (cdr lst))))))
+        (and (= (array-point arr pt) (first lst))
+             (loop (point-add pt di dj) (cdr lst))))))
 
 (define (count-xmas arr)
   (define-values (m n) (apply values (array-dimensions arr)))
@@ -28,35 +30,30 @@
     (stream-range (if (< dx 0) (* -3 dx) 0)
                   (if (> dx 0) (- size (* 3 dx)) size)))
   (define (count-dir di dj)
-    (define (count-row i)
-      (stream-length (stream-filter (cut start-word? arr i <> di dj)
-                                    (compute-range dj n))))
-    (stream-fold + 0 (stream-map count-row (compute-range di m))))
-  (stream-fold + 0
-               (stream-map (cut apply count-dir <>)
-                           (list->stream '((-1 -1) (-1 0) (-1 1) (0 -1) (0 1)
-                                           (1 -1) (1 0) (1 1))))))
-
-(define (is-x-mas? arr i j)
-  (and (= (array-ref arr i j) (char->integer #\A))
-       (let loop ((nm 0) (di '(1 1 -1 -1)) (dj '(1 -1 1 -1)))
-         (if (null-list? di)
+    (define-values (istart ipast) (compute-range di m))
+    (define-values (jstart jpast) (compute-range dj n))
+    (stream-length (stream-filter (cut start-word? arr <> di dj)
+                                  (square istart jstart ipast jpast))))
+  (stream-fold + 0 (stream-map (cut apply count-dir <>)
+                               (list->stream directions))))
+
+(define (is-x-mas? arr pt)
+  (and (= (array-point arr pt) (char->integer #\A))
+       (let loop ((nm 0) (diffs '((1 1) (1 -1) (-1 1) (-1 -1))))
+         (if (null-list? diffs)
              (= nm 2)
-             (let ((cur (array-ref arr (+ i (car di)) (+ j (car dj)))))
-               (cond ((= cur (char->integer #\M))
-                      (and (< nm 2) (loop (+ nm 1) (cdr di) (cdr dj))))
-                     ((= cur (char->integer #\S))
-                      (loop nm (cdr di) (cdr dj)))
-                     (else #f)))))
-       (not (= (array-ref arr (- i 1) (- j 1))
-               (array-ref arr (+ i 1) (+ j 1))))))
+             (let ((cur (array-point arr (apply point-add pt (car diffs)))))
+               (case (integer->char cur)
+                 ((#\M) (and (< nm 2) (loop (+ nm 1) (cdr diffs))))
+                 ((#\S) (loop nm (cdr diffs)))
+                 (else #f)))))
+       (not (= (array-point arr (point-add pt 1 1))
+               (array-point arr (point-add pt -1 -1))))))
 
 (define (count-x-mas arr)
   (define-values (m n) (apply values (array-dimensions arr)))
-  (define (count-row i)
-    (stream-length (stream-filter (cut is-x-mas? arr i <>)
-                                  (stream-range 1 (- n 1)))))
-  (stream-fold + 0 (stream-map count-row (stream-range 1 (- m 1)))))
+  (stream-length (stream-filter (cut is-x-mas? arr <>)
+                                (square 1 1 (- m 1) (- n 1)))))
 
 (define part1 (compose count-xmas read-input))