;(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 list-of-strings-p (list)
  "Return t if LIST is non nil and contains only strings."
  (and (consp list)
       (every #'stringp list)))

(deftype list-of-strings ()
  `(satisfies list-of-strings-p))


(declaim (ftype (function (list-of-strings) (simple-array standard-char (* *)))))
(defun parse-input (lines)
  (let ((l (length lines)))
    (make-array (list l l)
		:initial-contents (mapcar (lambda (s) (coerce s 'list)) lines))))

(declaim (type list-of-strings input-text))
(defparameter input-text (test-input 2024 6))
(declaim (type (simple-array standard-char (* *)) input-data))
(defparameter input-data 
  (parse-input (test-input 2024 6)))

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


(defparameter sample-data 
  (parse-input sample-text))
(deftype direction () '(member :north :east :south :west))
(defstruct guard
  (x 0 :type fixnum)
  (y 0 :type fixnum)
  (dir :north :type direction))


(defun blockedp (labo g &optional extra-block)
  (or (eq #\# (aref labo (guard-y g) (guard-x g)))
      (and
       extra-block
       (eq (guard-x g) (car extra-block))
       (eq (guard-y g) (cdr extra-block)))))

(defun find-guard (labo)
  (declare (type (array t (* *)) labo))
  (first (loop for x from 0 to (1- (array-dimension labo 0))
	       append (loop for y from 0 to (1- (array-dimension labo 1))
			    if (eq #\^ (aref labo y x))
			      collect (make-guard :x x :y y :dir :north)))))

(defun move (g)
  (declare (type guard g))
  (let ((dir (guard-dir g)))
    (case dir
      (:north (make-guard :x (guard-x g)      :y (1- (guard-y g)) :dir dir))
      (:east  (make-guard :x (1+ (guard-x g)) :y (guard-y g)     :dir dir))
      (:south (make-guard :x (guard-x g)      :y (1+ (guard-y g)) :dir dir))
      (:west  (make-guard :x (1- (guard-x g)) :y (guard-y g)      :dir dir)))))

(defun out-labop (labo g)
  (declare (type (array t (* *)) labo)
	   (type (or null guard) g))
  (not
   (and
    g
    (< -1 (guard-x g) (array-dimension labo 1))
    (< -1 (guard-y g) (array-dimension labo 0)))))


(defun guard-rotate (g)
  (declare (type guard g))
  (make-guard :x (guard-x g) :y (guard-y g)
	      :dir (case (guard-dir g)
		     (:north :east)
		     (:east :south)
		     (:south :west)
		     (:west :north))))

(defun guard-move (labo guard &optional (extra-block nil))
  (let ((new-guard (move guard)))
    (cond
      ((out-labop labo new-guard) nil)
      ((blockedp labo new-guard extra-block)
       (guard-move labo (guard-rotate guard) extra-block))
      (t new-guard))))

(defun guard-hash (g)
  (declare (type (or null guard) g))
  (if g
      (+ (* 10000 (guard-y g))
	 (* 10 (guard-x g))
	 (case (guard-dir g)
	   (:north 0)
	   (:east 1)
	   (:south 2)
	   (:west 3)))
      0))

(defun hash-to-pos (h)
  (cons
   (floor (/ h 10000))
   (mod (floor (/ h 10)) 1000)
   ))

(defun guard-path (labo guard &optional (path (make-hash-table :size 10000)) (extra-block nil))
  (let ((hash (guard-hash guard)))
    (cond
      ((not guard) (remove-duplicates (loop for k being the hash-keys of path collect (floor (/ k 10)))))
      ((gethash hash path) nil)
      (t (progn
	   (setf (gethash hash path) 1)
	   (guard-path labo (guard-move labo guard extra-block) path extra-block))))))

(defun part1 (data)
  (format nil "~A" (length (guard-path data (find-guard data)))))

(defun looping-blocks (labo)
  (let* ((g (find-guard labo))
	 (route (guard-path labo g)))
    (loop for s in route
	  for b = (cons (mod s 1000) (floor (/ s 1000))) 
	  unless (guard-path labo g (make-hash-table :size 10000) b)
	    collect b)))

(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)))