day-15.lisp (4822B)
1 (defpackage #:aoc/day-15 2 (:use #:cl #:aoc/utils) 3 (:export 4 #:follow-directions 5 #:day-15)) 6 (in-package #:aoc/day-15) 7 8 (defparameter *moves* '(:up (0 . -1) :down (0 . 1) 9 :left (-1 . 0) :right (1 . 0))) 10 11 (defun read-directions (input) 12 (loop for line = (read-line input nil) 13 until (null line) 14 nconc (mapcar (lambda (c) 15 (ecase c 16 (#\^ :up) 17 (#\< :left) 18 (#\> :right) 19 (#\v :down))) 20 (coerce line 'list)))) 21 22 (defun expand-map (map) 23 (loop with width = (* (input-map-width map) 2) 24 with height = (input-map-height map) 25 with new-map = (make-empty-map width height) 26 for y from 0 below (input-map-height map) 27 do (loop for x from 0 below (input-map-width map) 28 for point = (cons x y) 29 for new-point-left = (cons (* x 2) y) 30 for new-point-right = (cons (+ (* x 2) 1) y) 31 for cell = (map-cell map point) 32 unless (char= cell #\.) 33 do (setf (map-cell new-map new-point-left) 34 (ecase cell 35 (#\# #\#) 36 (#\O #\[)) 37 (map-cell new-map new-point-right) 38 (ecase cell 39 (#\# #\#) 40 (#\O #\])))) 41 finally (return new-map))) 42 43 (defun find-robot (map) 44 (loop for y from 0 below (input-map-height map) 45 thereis (loop for x from 0 below (input-map-width map) 46 for pos = (cons x y) 47 when (char= #\@ (map-cell map pos)) 48 do (return pos)))) 49 50 (defun move-boxes-basic (map pos direction) 51 (let* ((cell (map-cell map pos)) 52 (diff (getf *moves* direction)) 53 (next (point+ pos diff))) 54 (case cell 55 (#\. (return-from move-boxes-basic t)) 56 (#\# (return-from move-boxes-basic nil))) 57 (when (move-boxes map next direction) 58 (setf (map-cell map next) cell 59 (map-cell map pos) #\.) 60 t))) 61 62 (defun box-positions (map pos) 63 (case (map-cell map pos) 64 (#\[ (list pos (point+ pos '(1 . 0)))) 65 (#\] (list pos (point- pos '(1 . 0)))))) 66 67 (defun clean-positions (positions) 68 (remove-duplicates (remove nil positions) :test #'equal)) 69 70 (defun move-boxes (map pos direction) 71 (case (map-cell map pos) 72 (#\. (return-from move-boxes t)) 73 (#\O (return-from move-boxes 74 (move-boxes-basic map pos direction))) 75 (#\# (return-from move-boxes nil))) 76 (when (member direction '(:left :right)) 77 (return-from move-boxes (move-boxes-basic map pos direction))) 78 (loop with diff = (getf *moves* direction) 79 with positions = (box-positions map pos) 80 with to-be-moved = (list positions) 81 for y = (point-y pos) then (+ y (point-y diff)) 82 do (setf positions 83 (clean-positions 84 (loop for position in positions 85 for next = (point+ position diff) 86 nconc (case (map-cell map next) 87 (#\# (return-from move-boxes nil)) 88 (#\. nil) 89 (t (box-positions map next)))))) 90 (push positions to-be-moved) 91 until (null positions) 92 finally (loop for set in to-be-moved 93 do (loop for position in set 94 for next = (point+ position diff) 95 do (setf (map-cell map next) (map-cell map position) 96 (map-cell map position) #\.)))) 97 t) 98 99 (defun all-boxes-gps-coords (map) 100 (loop for y from 0 below (input-map-height map) 101 sum (loop for x from 0 below (input-map-width map) 102 for pos = (cons x y) 103 for cell = (map-cell map pos) 104 when (or (char= cell #\O) 105 (char= cell #\[)) 106 sum (+ (* y 100) x)))) 107 108 (defun follow-directions (map pos directions) 109 (loop for direction in directions 110 for i from 0 111 for new-pos = (point+ pos (getf *moves* direction)) 112 when (move-boxes map new-pos direction) 113 do (setf pos new-pos))) 114 115 (defun day-15 (input) 116 (let* ((map-1 (make-map input)) 117 (pos (find-robot map-1)) 118 (map-2 (progn 119 (setf (map-cell map-1 pos) #\.) 120 (expand-map map-1))) 121 (directions (read-directions input))) 122 (follow-directions map-1 pos directions) 123 (follow-directions map-2 (point* pos (cons 2 1)) directions) 124 (values (all-boxes-gps-coords map-1) 125 (all-boxes-gps-coords map-2))))