day-16.lisp (2767B)
1 (defpackage #:aoc/day-16 2 (:use #:cl #:aoc/utils) 3 (:export #:day-16)) 4 (in-package #:aoc/day-16) 5 6 (defconstant +pipe-char+ (code-char 124)) 7 8 (defun next-directions (cell direction) 9 (eswitch (cell) 10 (#\/ (switch (direction) 11 (:right '(:up)) 12 (:down '(:left)) 13 (:up '(:right)) 14 (:left '(:down)))) 15 (#\\ (switch (direction) 16 (:right '(:down)) 17 (:down '(:right)) 18 (:up '(:left)) 19 (:left '(:up)))) 20 (#\- (switch (direction) 21 (:down '(:right :left)) 22 (:up '(:right :left)) 23 (t (list direction)))) 24 (+pipe-char+ 25 (switch (direction) 26 (:left '(:up :down)) 27 (:right '(:up :down)) 28 (t (list direction)))) 29 (#\. (list direction)))) 30 31 (defun move-position (pos direction) 32 (eswitch (direction) 33 (:right (point+ pos (cons 1 0))) 34 (:down (point+ pos (cons 0 1))) 35 (:up (point+ pos (cons 0 -1))) 36 (:left (point+ pos (cons -1 0))))) 37 38 (defun shoot-beam (map start-pos start-dir) 39 (loop with energizing-map = (make-hash-table :test 'equal) 40 with passing-map = (make-hash-table :test 'equal) 41 with todo = (list (list start-pos start-dir)) 42 with width = (input-map-width map) 43 with height = (input-map-height map) 44 for (pos direction) = (pop todo) 45 while pos 46 for cell = (map-cell map pos) 47 for directions = (next-directions cell direction) 48 do (setf (gethash pos energizing-map) 49 (1+ (or (gethash pos energizing-map) 0)) 50 (gethash (list pos direction) passing-map) 51 t) 52 do (loop for dir in directions 53 for new-pos = (move-position pos dir) 54 unless (or (< (point-x new-pos) 0) 55 (< (point-y new-pos) 0) 56 (>= (point-x new-pos) width) 57 (>= (point-y new-pos) height) 58 (gethash (list new-pos dir) passing-map)) 59 do (push (list new-pos dir) todo)) 60 finally (return (hash-table-count energizing-map)))) 61 62 (defun day-16 (input) 63 (let* ((map (make-map input)) 64 (task-1 (shoot-beam map (cons 0 0) :right)) 65 (width (input-map-width map)) 66 (height (input-map-height map))) 67 (values task-1 68 (max 69 (loop for (row dir) in `((0 :down) (,(1- height) :up)) 70 maximize (loop for x from 0 below width 71 maximize (shoot-beam map (cons x row) dir))) 72 (loop for (col dir) in `((0 :right) (,(1- width) :left)) 73 maximize (loop for y from 0 below height 74 maximize (shoot-beam map (cons col y) dir)))))))