day-18.lisp (2619B)
1 (defpackage #:aoc/day-18 2 (:use #:cl #:aoc/utils) 3 (:export 4 #:*width* 5 #:*height* 6 #:*bytes-falling* 7 #:day-18)) 8 (in-package #:aoc/day-18) 9 10 (defparameter *width* 71) 11 (defparameter *height* 71) 12 (defparameter *bytes-falling* 1024) 13 (defparameter *directions* '((1 . 0) (-1 . 0) 14 (0 . 1) (0 . -1))) 15 16 (defun parse-coordinate (line) 17 (multiple-value-bind (x end) 18 (parse-integer line :junk-allowed t) 19 (cons x (parse-integer line :start (1+ end))))) 20 21 (defun parse-coordinates (input) 22 (loop for line = (read-line input nil) 23 for i from 0 24 until (null line) 25 collect (parse-coordinate line))) 26 27 (declaim (inline fall-byte unfall-byte)) 28 29 (defun fall-byte (map position) 30 (setf (map-cell map position) #\#)) 31 32 (defun unfall-byte (map position) 33 (setf (map-cell map position) #\.)) 34 35 (defun draw-map (map visited) 36 (loop for y from 0 below *height* 37 do (loop for x from 0 below *width* 38 for pos = (cons x y) 39 do (format t "~A" (or (and (gethash pos visited) #\O) 40 (map-cell map pos)))) 41 (format t "~%"))) 42 43 (defun bfs (map) 44 (loop with queue = (make-queue :simple-queue) 45 with start = (cons 0 0) 46 with end = (cons (1- *width*) (1- *height*)) 47 with visited = (make-hash-table :test #'equal) 48 initially (qpush queue (list start 0)) 49 (setf (gethash start visited) t) 50 for (pos steps) = (qpop queue) 51 when (null pos) 52 do (return nil) 53 when (equal pos end) 54 do (return steps) 55 do (loop for dir in *directions* 56 for next = (point+ pos dir) 57 when (and (point-in-bounds-p next *width* *height*) 58 (not (gethash next visited)) 59 (char/= (map-cell map next) #\#)) 60 do (qpush queue (list next (1+ steps))) 61 (setf (gethash next visited) t)))) 62 63 (defun task-2 (map coordinates) 64 (loop for byte in coordinates 65 do (fall-byte map byte)) 66 (loop for byte in (nreverse coordinates) 67 do (unfall-byte map byte) 68 when (bfs map) 69 do (return byte))) 70 71 (defun day-18 (input) 72 (let* ((map (make-empty-map *width* *height*)) 73 (coordinates (parse-coordinates input))) 74 (loop repeat *bytes-falling* 75 for cdr on coordinates 76 do (fall-byte map (car cdr)) 77 finally (setf coordinates cdr)) 78 (values (bfs map) 79 (let ((p (task-2 map coordinates))) 80 (format nil "~A,~A" (point-x p) (point-y p))))))