229 lines
6.1 KiB
Common Lisp
229 lines
6.1 KiB
Common Lisp
|
|
(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))))
|