(declaim (optimize (speed 3) (debug 0) (safety 0)))

(defpackage :aoc/2024/06
  (:use :cl :aoc :alexandria :trivia)
  (:export
   #:sample-data
   #:sample-data2
   #:part1
   #:part2
   ))

(in-package :aoc/2024/06)





(defun parse-input (lines)
  (let ((l (length lines)))
    (make-array (list l l)
		:initial-contents (mapcar (lambda (s) (coerce s 'list)) lines))))

(defparameter input-text (test-input 2024 6))
(defparameter input-data 
  (parse-input (test-input 2024 6)))

(defparameter sample-text (aoc:split-lines "....#.....
.........#
..........
..#.......
.......#..
..........
.#..^.....
........#.
#.........
......#...
"))
(defparameter sample-data 
  (parse-input sample-text))

(defun make-guard (pos direction)
  (list pos direction))

(defun guardp (labo pos)
  (eq #\^ (aref labo (second pos) (first pos))))

(defun blockedp (labo pos)
  (eq #\# (aref labo (second pos) (first pos))))

(defun find-guard (labo)
  (make-guard
   (loop for x from 0 to (1- (array-dimension labo 0))
	 for guard-pos =			(loop for y from 0 to (1- (array-dimension labo 1))
						      for pos = (list x y)
						      if (guardp labo pos)
							return pos)
	 if guard-pos
	   return guard-pos)
   :north))

(defun move (pos direction)
  (destructuring-bind (x y) pos
    (case direction
      (:north (list x (1- y)))
      (:east (list (1+ x) y))
      (:south (list x (1+ y)))
      (:west (list (1- x) y)))))

(defun out-labop (labo pos)
  (destructuring-bind (x y) pos
    (or
     (< x 0)
     (< y 0)
     (>= x (array-dimension labo 1))
     (>= y (array-dimension labo 1)))))

(defun guard-rotate (guard)
  (let ((direction (second guard)))
    (make-guard
     (first guard)
     (case direction
       (:north :east)
       (:east :south)
       (:south :west)
       (:west :north)))))

(defun guard-move (labo guard &optional (extra-block nil))
  (destructuring-bind (pos dir) guard
    (let ((new-pos (move pos dir)))
      (cond
	((out-labop labo new-pos) nil)
	((or (blockedp labo new-pos)
	     (equal new-pos extra-block))
	 (guard-move labo (guard-rotate guard) extra-block))
	(t (make-guard new-pos dir))))))

(defun guard-path (labo guard &optional (path nil) (extra-block nil))
  (cond
    ((member guard path :test #'equal) nil)
    ((emptyp guard) (reverse path))
    (t (guard-path labo (guard-move labo guard extra-block) (push guard path) extra-block))))

(defun number-squares-covered-by-guard (labo)
  (let ((squares (mapcar #'first (guard-path labo (find-guard labo)))))
    (length (remove-duplicates squares :test #'equal))))


(defun part1 (data)
  (format nil "~A" (number-squares-covered-by-guard data)))

(defun looping-blocks (labo)
  (let* ((g (find-guard labo))
	 (route (guard-path labo g)))
    (remove-duplicates
     (loop for s in route
	   for b = (first s)
	   unless (guard-path labo g '() b)
	     collect b)
     :test #'equal)))

(defun part2 (data)
  (let* ((lb (looping-blocks data)))
    (format nil "~A" (length lb))))

(defun solve-day ()
  (format t "part1: ~A~%" (part1 input-data))
  (format t "part2: ~A~%" (part2 input-data)))