(defpackage #:advent.2024.04
  (:use #:cl #:advent.2024.00))
(in-package #:advent.2024.04)

(defvar *input* "04.input")

;;; Part 1. Ceres Search
;; Find all occurrences of the word XMAS, in any orientation, in the puzzle
;; input.

(defun transpose (list)
  "Transpose LIST, a list of lists."
  (apply #'mapcar #'list list))

;; How to diagonalize a list?
;;
;; (1,1) (1,2) (1,3) (1,4)
;; (2,1) (2,2) (2,3) (2,4)
;; (3,1) (3,2) (3,3) (3,4)
;; (4,1) (4,2) (4,3) (4,4)
;; =>
;; (1,1)
;; (2,1) (1,2)
;; (3,1) (2,2) (1,3)
;; (4,1) (3,2) (2,3) (1,4)
;; (4,2) (3,3) (2,4)
;; (4,3) (3,4)
;; (4,4)
;;
;; So each diagonal's coordinates add up to the same number every time.

(defun diagonalize (list)
  "Return a list of lists of LIST's (a list of lists) diagonals."
  ;; Thankfully all the lines are the same length
  (let ((listvec (list->vector (mapcar #'list->vector list)))
        (res (make-array (list (* 2 (length list)))
                         :initial-element ())))
    (dotimes (row (length listvec) res)
      (dotimes (col (length listvec))
        (let ((el (aref (aref listvec row) col)))
          (when el
            (push el (aref res (+ row col)))))))
    (vector->list (remove-if #'null res))))

(defun count-occurrences (regex list)
  "Count the occurences of REGEX in a LIST of strings."
  (let ((list (if (stringp (car list))
                  list
                  (mapcar (lambda (s) (concatenate 'string s)) list))))
    (loop for s in list
          sum (ppcre:count-matches regex s))))

(defvar *needle* "XMAS")

(defun solve1 (&optional str)
  (let* ((horiz-lines (or (ppcre:split #\Newline str)
                          (uiop:read-file-lines *input*)))
         (e->w (count-occurrences *needle* horiz-lines))
         (w->e (count-occurrences *needle* (mapcar #'reverse horiz-lines)))
         (chars (mapcar #'vector->list horiz-lines))
         (vert-lines (transpose chars))
         (n->s (count-occurrences *needle* vert-lines))
         (s->n (count-occurrences *needle* (mapcar #'reverse vert-lines)))
         (/-lines (diagonalize chars))
         (sw->ne (count-occurrences *needle* /-lines))
         (ne->sw (count-occurrences *needle* (mapcar #'reverse /-lines)))
         (\\-lines (diagonalize (mapcar #'reverse (transpose chars))))
         (se->nw (count-occurrences *needle* \\-lines))
         (nw->se (count-occurrences *needle* (mapcar #'reverse \\-lines))))
    (+ e->w w->e
       n->s s->n
       sw->ne ne->sw
       se->nw nw->se)))

;; 2629 -> TOO HIGH
;; --- I had to diagonalize the reversed transpose! oof buddy

;;; part 2. X-MAS
;; Instead of finding XMAS, you need to find this pattern, tho any MAS can be backward:
;; M _ S
;; _ A _
;; M _ S
;;
;; Thoughts:
;; I could look for MAS or SAM, since it can be backward. Oh I could've done
;; that before too, lmao... ok. I just have to do sw->ne and se->nw basically.
;;
;; OR I could do this vector-style: go through the 2d array looking for A, then
;; check (aref arr (1- A) (1- A)) for M or S, and so on. ... that might make
;; more sense

(defun list-of-strings->2d-array (strlist)
  ;; Assumes that every string in the list is the same length
  (let ((rowlen (length (car strlist)))
        (collen (length strlist)))
    (make-array (list rowlen collen)
                :initial-contents (mapcar #'vector->list strlist))))

(defun solve2 (&optional s)
  (let* ((in (or (ppcre:split #\Newline s)
                 (uiop:read-file-lines *input*)))
         (a (list-of-strings->2d-array in))
         (sum 0))
    (destructuring-bind (n m) (array-dimensions a)
      (loop for i from 1 below (1- n) do
        (loop for j from 1 below (1- m) do
          (when (and (char= #\A (aref a i j))
                     (or (and (char= #\M (aref a (1- i) (1- j)))
                              (char= #\S (aref a (1+ i) (1+ j))))
                         (and (char= #\S (aref a (1- i) (1- j)))
                              (char= #\M (aref a (1+ i) (1+ j)))))
                     (or (and (char= #\M (aref a (1+ i) (1- j)))
                              (char= #\S (aref a (1- i) (1+ j))))
                         (and (char= #\S (aref a (1+ i) (1- j)))
                              (char= #\M (aref a (1- i) (1+ j))))))
            (incf sum)))))
    sum))