(defpackage :aoc/2024/15
  (:use :cl :aoc :alexandria :trivia :lla)
  (:export
   #:sample-data
   #:sample-data2
   #:parse-line
   #:parse-input
   #:make-pos
   #:pos-x
   #:pos-y
   #:show-map
   #:find-robot
   #:move-robot
   #:move-pos
   #:big-warehouse
   #:total-gps
   #:part1
   #:part2
   ))

(in-package :aoc/2024/15)


(defun parse-line (line)
  (coerce line 'list))


(defun parse-input (lines)
  (let* ((rows (mapcar #'parse-line lines))
	 (split (position-if #'null rows)))
    (cons
     (make-array
      `(,split ,(length (first rows)))
      :initial-contents (subseq rows 0 split))
     (reduce
      (lambda (acc r)
	(append acc (coerce r 'list)))
      (subseq rows (1+ split)))
     )))

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

(defparameter sample-text (aoc:split-lines "##########
#..O..O.O#
#......O.#
#.OO..O.O#
#..O@..O.#
#O#..O...#
#O..O..O.#
#.OO.O.OO#
#....O...#
##########

<vv>^<v^>v>^vv^v>v<>v^v<v<^vv<<<^><<><>>v<vvv<>^v^>^<<<><<v<<<v^vv^v>^
vvv<<^>^v^^><<>>><>^<<><^vv^^<>vvv<>><^^v>^>vv<>v<<<<v<^v>^<^^>>>^<v<v
><>vv>v^v^<>><>>>><^^>vv>v<^^^>>v^v^<^^>v^^>v^<^v>v<>>v^v^<v>v^^<^^vv<
<<v<^>>^^^^>>>v^<>vvv^><v<<<>^^^vv^<vvv>^>v<^^^^v<>^>vvvv><>>v^<<^^^^^
^><^><>>><>^^<<^^v>>><^<v>^<vv>>v>>>^v><>^v><<<<v>>v<v<v>vvv>^<><<>^><
^>><>^v<><^vvv<^^<><v<<<<<><^v<<<><<<^^<v<^^^><^>>^<v^><<<^>>^v<v^v<v^
>^>>^v>vv>^<<^v<>><<><<v<<v><>v<^vv<<<>^^v^>^^>>><<^v>>v^v><^^>>^<>vv^
<><^^>^^^<><vvvvv^v<v<<>^v<v>v<<^><<><<><<<^^<<<^<<>><<><^^^>^^<>^>v<>
^^>vv<^v^v<vv>^<><v<^v>^^^>>>^^vvv^>vvv<>>>^<^>>>>>^<<^v>^vvv<>^<><<v>
v^^>>><<^^<>>^v^<v^vv<>v^<<>^<^v^v><^<<<><<^<v><v<>vv>>v><v^<vv<>v^<<^"))

(defparameter sample-data 
  (parse-input sample-text))



(defstruct pos
  (x 0 :type fixnum)
  (y 0 :type fixnum))

(defun pos-move (pos dir)
  (case dir
    (#\^ (make-pos :x (pos-x pos) :y (1- (pos-y pos))))
    (#\v (make-pos :x (pos-x pos) :y (1+ (pos-y pos))))
    (#\< (make-pos :x (1- (pos-x pos)) :y (pos-y pos)))
    (#\> (make-pos :x (1+ (pos-x pos)) :y (pos-y pos)))
    ))

(defun pos-gps (pos)
  (+ (* 100 (pos-y pos)) (pos-x pos)))

(defun show-map (map &optional (dest t))
  (let ((w (array-dimension map 1))
	(h (array-dimension map 0)))
    (format
     dest "~{~A~}"
     (loop
       for row from 0 below h
       collect (format nil "~A~%"
		       (coerce
			(loop for col from 0 below w
			      collect (aref map row col))
			'string))))))

(defun get-pos (map pos)
  (aref map (pos-y pos) (pos-x pos)))

(defun find-robot (map)
  (let ((w (array-dimension map 1))
	(h (array-dimension map 0)))
    (loop
      for row from 0 below h
      for col = (loop
		  for col from 0 below w
		  if (eq (aref map row col) #\@) return col)
      if col
	return (make-pos :x col :y row)
      )))

(defun swap-pos (map p np)
  "swaps content of map. returns np"
  (let ((o (get-pos map p)))
    (setf (aref map (pos-y p) (pos-x p)) (get-pos map np))
    (setf (aref map (pos-y np) (pos-x np)) o)
    np))


(defun total-gps (map)
  (loop
    for row from 0 below (array-dimension map 0)
    sum (loop
	  for col from 0 below (array-dimension map 1)
	  for p = (make-pos :x col :y row)
	  if (member (get-pos map p) '(#\O #\[))
	    sum (pos-gps p))))

(defun merge-pushes (dir pa pb)
  "remove duplicate swaps and return them in the right order"
  (sort
   (remove-duplicates (append pa pb) :test #'equalp)
   (if (eq dir #\^) #'< #'>)
   :key #'(lambda (p) (pos-y (cdr p)))))

(defun try-move-pos (map pos dir &optional (swaps nil))
  "return new position if valid otherwise nil. returns a list of swaps"
  (let* ((np (pos-move pos dir))
	 (object (get-pos map pos)))
    (ccase object 
      (#\# nil)
      (#\. swaps)
      (#\@ (try-move-pos map np dir (push (cons pos np) swaps)))
      (#\O (try-move-pos map np dir (push (cons pos np) swaps)))
      (#\[ (progn
	     (ccase dir
	       ((#\< #\>) (try-move-pos map np dir (push (cons pos np) swaps)))
	       ((#\^ #\v) (let* ((pos2 (make-pos :x (1+ (pos-x pos)) :y (pos-y pos)))
				 (np2 (make-pos :x (1+ (pos-x np)) :y (pos-y np)))
				 (push1 (try-move-pos map np dir (list (cons pos np))))
				 (push2 (try-move-pos map np2 dir (list (cons pos2 np2)))))
			    (if (and push1 push2)
				(append
				 (merge-pushes dir push1 push2)
				 swaps				 
				 ))))
	       )))
      (#\] (progn
	     (ccase dir
	       ((#\< #\>) (try-move-pos map np dir (push (cons pos np) swaps)))
	       ((#\^ #\v) (let* ((pos2 (make-pos :x (1- (pos-x pos)) :y (pos-y pos)))
				 (np2 (make-pos :x (1- (pos-x np)) :y (pos-y np)))
				 (push1 (try-move-pos map np dir (list (cons pos np))))
				 (push2 (try-move-pos map np2 dir (list (cons pos2 np2)))))
			    (if (and push1 push2)
				(append
				 (merge-pushes dir push1 push2)
				 swaps				 
				 ))))
	       ))))))

(defun move-pos (map pos dir)
  (let ((swaps (try-move-pos map pos dir)))
    (loop for swap in swaps
	  do (swap-pos map (car swap) (cdr swap)))
    (and swaps (pos-move pos dir))))

(defun move-robot (og-map moves)
  (let ((map (copy-array og-map))
	(robot (find-robot og-map)))
    (loop for move in moves
	  for np = (move-pos map robot move)
	  if np
	    do (setf robot np))
    map))

(defun big-warehouse (sm)
  (make-array
   (list (array-dimension sm 1) (* 2 (array-dimension sm 0)))
   :initial-contents
   (loop for row from 0 below (array-dimension sm 1)
	 collect (loop
		   for col from 0 below (array-dimension sm 0)
		   append (case (aref sm row col)
			    (#\@ '(#\@ #\.))
			    (#\# '(#\# #\#))
			    (#\O '(#\[ #\]))
			    (#\. '(#\. #\.)))))))



(defun solve-part1 (data)
  (let ((map (car data))
	(moves (cdr data)))
    (total-gps  (move-robot map moves))))

(defun solve-part2 (data)
  (let ((map (big-warehouse (car data)))
	(moves (cdr data)))
    (total-gps (move-robot map moves))))

(defun part1 (data)
  (format nil "~A" (solve-part1 data)))

(defun part2 (data)
  (format nil "~A" (solve-part2 data)))

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

(defun submit ()
  (let ((p1 (part1 input-data))
        (p2 (part2 input-data)))
    (if p1 (submit-part1 2024 15 p1))
    (if p2 (submit-part2 2024 15 p2))))