day 4

1 files changed, 75 insertions, 0 deletions

diff --git a/04/1.scm b/04/1.scm
new file mode 100644
index 0000000..dd5c26d
--- /dev/null
+++ b/04/1.scm
@@ -0,0 +1,75 @@
+(import (chicken string))
+(import (chicken io))
+(import (chicken sort))
+(import matchable)
+(import srfi-1)
+(import regex)
+
+(define input
+  (with-input-from-file "input"
+    (lambda ()
+      (let loop ((ret '()))
+        (let ((line (read-line)))
+          (if (eof-object? line)
+              (reverse ret)
+              (loop (cons line ret))))))))
+
+(define (transpose in)
+  (define cols (string-length (car in)))
+  (let loop ((i 0) (ret '()))
+    (if (>= i cols)
+        (reverse ret)
+        (loop (+ i 1) (cons (list->string (map (lambda (x) (string-ref x i))
+                                                in))
+                            ret)))))
+
+(define (flip in)
+  (define (flip-row row)
+    (list->string (reverse (string->list row))))
+  (map flip-row in))
+
+(define (char-at in x y)
+  (string-ref (list-ref in y) x))
+
+(define (diag in)
+  (define width (string-length (car in)))
+  (define height (length in))
+  (define (diag-start-at x y)
+    (let loop ((cur-row y) (cur-col x) (ret '()))
+      (if (or (< cur-col 0)
+              (>= cur-row height))
+          (list->string (reverse ret))
+          (loop (+ cur-row 1)
+                (- cur-col 1)
+                (cons (char-at in cur-col cur-row) ret)))))
+  (define (row-diag in)
+    (let loop ((i 0) (ret '()))
+      (if (>= i width)
+          (reverse ret)
+          (loop (+ 1 i) (cons (diag-start-at i 0) ret)))))
+  (define (col-diag in)
+    (let loop ((i 1) (ret '()))
+      (if (>= i height)
+          (reverse ret)
+          (loop (+ i 1) (cons (diag-start-at (- width 1) i) ret)))))
+  (append (row-diag in) (col-diag in)))
+
+(define (count-xmas str)
+  (define len (string-length str))
+  (let loop ((cur 0) (count 0))
+    (define pos (string-search-positions "XMAS" str cur))
+    (if pos
+        (loop (cadar pos) (+ 1 count))
+        count)))
+
+(define (count-mat mat)
+  (apply + (map count-xmas mat)))
+
+(define mat-list
+  (list input (flip input)
+        (transpose input) (flip (transpose input))
+        (diag input) (flip (diag input))
+        (diag (flip input)) (flip (diag (flip input)))))
+
+(display (apply + (map count-mat mat-list)))
+(newline)