day-6.lisp (3502B)
1 (defpackage #:aoc/day-6 2 (:use #:cl #:aoc/utils) 3 (:export #:day-6)) 4 (in-package #:aoc/day-6) 5 6 (defun find-guard (map) 7 (loop for y from 0 below (input-map-height map) 8 thereis (loop for x from 0 below (input-map-width map) 9 for point = (cons x y) 10 for cell = (map-cell map point) 11 when (char= cell #\^) 12 do (return point)))) 13 14 (defun next (point direction) 15 (point+ 16 point 17 (ecase direction 18 (:up (cons 0 -1)) 19 (:left (cons -1 0)) 20 (:right (cons 1 0)) 21 (:down (cons 0 1))))) 22 23 (defun turn (direction) 24 (ecase direction 25 (:up :right) 26 (:right :down) 27 (:down :left) 28 (:left :up))) 29 30 (declaim (ftype (function (fixnum fixnum) (simple-array t (* * 4))) make-visited-cache)) 31 (defun make-visited-cache (width height) 32 (make-array (list width height 4) 33 :initial-element nil)) 34 35 (declaim (inline visited-p 36 (setf visited-p))) 37 38 (defun visited-p (cache point dir) 39 (destructuring-bind (x . y) point 40 (aref cache x y (ecase dir 41 (:up 0) 42 (:left 1) 43 (:right 2) 44 (:down 3))))) 45 46 (defun (setf visited-p) (new-value cache point dir) 47 (destructuring-bind (x . y) point 48 (setf (aref cache x y (ecase dir 49 (:up 0) 50 (:left 1) 51 (:right 2) 52 (:down 3))) 53 new-value))) 54 55 (defun walk-map (map pos &optional check-loops) 56 (loop with dir = :up 57 with map-width = (input-map-width map) 58 with map-height = (input-map-height map) 59 with visited-dir = (make-visited-cache map-width map-height) 60 with visited = (make-array (list map-width map-height) 61 :initial-element nil) 62 with count-visited fixnum = 0 63 while (point-in-bounds-p pos map-width map-height) 64 when (and check-loops (visited-p visited-dir pos dir)) 65 do (return :loop) 66 when check-loops 67 do (setf (visited-p visited-dir pos dir) t) 68 do (destructuring-bind (x . y) pos 69 (unless (aref visited x y) 70 (incf count-visited) 71 (setf (aref visited x y) t))) 72 (setf pos (loop with next = (next pos dir) 73 while (and (point-in-bounds-p next map-width map-height) 74 (char= (map-cell map next) #\#)) 75 do (setf dir (turn dir) 76 next (next pos dir)) 77 finally (return next))) 78 finally (return (values count-visited visited)))) 79 80 (defun task-2 (map initial-pos visited) 81 (loop with task-2 = 0 82 for x from 0 below (input-map-width map) 83 do (loop for y from 0 below (input-map-height map) 84 for point = (cons x y) 85 when (and (aref visited x y) 86 (char= (map-cell map point) #\.)) 87 do (setf (map-cell map point) #\#) 88 (when (eq (walk-map map initial-pos t) :loop) 89 (incf task-2)) 90 (setf (map-cell map point) #\.)) 91 finally (return task-2))) 92 93 (defun day-6 (input) 94 (let* ((map (make-map input)) 95 (pos (find-guard map))) 96 (multiple-value-bind (task-1 visited) 97 (walk-map map pos) 98 (values task-1 (task-2 map pos visited)))))