1(defpackage #:advent.2024.04
2 (:use #:cl #:advent.2024.00))
3(in-package #:advent.2024.04)
4
5(defvar *input* "04.input")
6
7;;; Part 1. Ceres Search
8;; Find all occurrences of the word XMAS, in any orientation, in the puzzle
9;; input.
10
11(defun transpose (list)
12 "Transpose LIST, a list of lists."
13 (apply #'mapcar #'list list))
14
15;; How to diagonalize a list?
16;;
17;; (1,1) (1,2) (1,3) (1,4)
18;; (2,1) (2,2) (2,3) (2,4)
19;; (3,1) (3,2) (3,3) (3,4)
20;; (4,1) (4,2) (4,3) (4,4)
21;; =>
22;; (1,1)
23;; (2,1) (1,2)
24;; (3,1) (2,2) (1,3)
25;; (4,1) (3,2) (2,3) (1,4)
26;; (4,2) (3,3) (2,4)
27;; (4,3) (3,4)
28;; (4,4)
29;;
30;; So each diagonal's coordinates add up to the same number every time.
31
32(defun diagonalize (list)
33 "Return a list of lists of LIST's (a list of lists) diagonals."
34 ;; Thankfully all the lines are the same length
35 (let ((listvec (list->vector (mapcar #'list->vector list)))
36 (res (make-array (list (* 2 (length list)))
37 :initial-element ())))
38 (dotimes (row (length listvec) res)
39 (dotimes (col (length listvec))
40 (let ((el (aref (aref listvec row) col)))
41 (when el
42 (push el (aref res (+ row col)))))))
43 (vector->list (remove-if #'null res))))
44
45(defun count-occurrences (regex list)
46 "Count the occurences of REGEX in a LIST of strings."
47 (let ((list (if (stringp (car list))
48 list
49 (mapcar (lambda (s) (concatenate 'string s)) list))))
50 (loop for s in list
51 sum (ppcre:count-matches regex s))))
52
53(defvar *needle* "XMAS")
54
55(defun solve1 (&optional str)
56 (let* ((horiz-lines (or (ppcre:split #\Newline str)
57 (uiop:read-file-lines *input*)))
58 (e->w (count-occurrences *needle* horiz-lines))
59 (w->e (count-occurrences *needle* (mapcar #'reverse horiz-lines)))
60 (chars (mapcar #'vector->list horiz-lines))
61 (vert-lines (transpose chars))
62 (n->s (count-occurrences *needle* vert-lines))
63 (s->n (count-occurrences *needle* (mapcar #'reverse vert-lines)))
64 (/-lines (diagonalize chars))
65 (sw->ne (count-occurrences *needle* /-lines))
66 (ne->sw (count-occurrences *needle* (mapcar #'reverse /-lines)))
67 (\\-lines (diagonalize (mapcar #'reverse (transpose chars))))
68 (se->nw (count-occurrences *needle* \\-lines))
69 (nw->se (count-occurrences *needle* (mapcar #'reverse \\-lines))))
70 (+ e->w w->e
71 n->s s->n
72 sw->ne ne->sw
73 se->nw nw->se)))
74
75;; 2629 -> TOO HIGH
76;; --- I had to diagonalize the reversed transpose! oof buddy
77
78;;; part 2. X-MAS
79;; Instead of finding XMAS, you need to find this pattern, tho any MAS can be backward:
80;; M _ S
81;; _ A _
82;; M _ S
83;;
84;; Thoughts:
85;; I could look for MAS or SAM, since it can be backward. Oh I could've done
86;; that before too, lmao... ok. I just have to do sw->ne and se->nw basically.
87;;
88;; OR I could do this vector-style: go through the 2d array looking for A, then
89;; check (aref arr (1- A) (1- A)) for M or S, and so on. ... that might make
90;; more sense
91
92(defun list-of-strings->2d-array (strlist)
93 ;; Assumes that every string in the list is the same length
94 (let ((rowlen (length (car strlist)))
95 (collen (length strlist)))
96 (make-array (list rowlen collen)
97 :initial-contents (mapcar #'vector->list strlist))))
98
99(defun solve2 (&optional s)
100 (let* ((in (or (ppcre:split #\Newline s)
101 (uiop:read-file-lines *input*)))
102 (a (list-of-strings->2d-array in))
103 (sum 0))
104 (destructuring-bind (n m) (array-dimensions a)
105 (loop for i from 1 below (1- n) do
106 (loop for j from 1 below (1- m) do
107 (when (and (char= #\A (aref a i j))
108 (or (and (char= #\M (aref a (1- i) (1- j)))
109 (char= #\S (aref a (1+ i) (1+ j))))
110 (and (char= #\S (aref a (1- i) (1- j)))
111 (char= #\M (aref a (1+ i) (1+ j)))))
112 (or (and (char= #\M (aref a (1+ i) (1- j)))
113 (char= #\S (aref a (1- i) (1+ j))))
114 (and (char= #\S (aref a (1+ i) (1- j)))
115 (char= #\M (aref a (1- i) (1+ j))))))
116 (incf sum)))))
117 sum))