advent-of-code-2023

My solutions to AoC 2023
git clone git://git.entf.net/advent-of-code-2023
Log | Files | Refs

day-21.lisp (2289B)


      1 (defpackage #:aoc/day-21
      2   (:use #:cl #:aoc/utils)
      3   (:export #:day-21))
      4 (in-package #:aoc/day-21)
      5 
      6 (defun find-start-position (map)
      7   (loop for y from 0 below (input-map-height map)
      8         do (loop for x from 0 below (input-map-width map)
      9                  for point = (cons x y)
     10                  when (char= (map-cell map point) #\S)
     11                    do (return-from find-start-position point))))
     12 
     13 (defun neighbouring-positions (position)
     14   (destructuring-bind (x . y)
     15       position
     16     (let (ps)
     17       (push (cons (1- x) y) ps)
     18       (push (cons (1+ x) y) ps)
     19       (push (cons x (1- y)) ps)
     20       (push (cons x (1+ y)) ps)
     21       ps)))
     22 
     23 (defun neighbouring-gardens (map width height position)
     24   (loop for n in (neighbouring-positions position)
     25         for cell = (map-cell map (destructuring-bind (x . y)
     26                                      n
     27                                    (cons (mod x width)
     28                                          (mod y height))))
     29         when (or (char= cell #\.)
     30                  (char= cell #\S))
     31           collect n))
     32 
     33 (defun step-through-garden (map position steps)
     34   (loop with todo = (list position)
     35         with width = (input-map-width map)
     36         with height = (input-map-height map)
     37         for remaining-steps downfrom steps
     38         when (= remaining-steps 0)
     39           do (return (length todo))
     40         do (setf todo
     41                  (remove-duplicates
     42                   (loop for position in todo
     43                         nconc (neighbouring-gardens map width height position))
     44                   :test #'equal))))
     45 
     46 (defun task-2 (map start-pos final-steps)
     47   (let* ((width (input-map-width map))
     48          (target (mod final-steps width))
     49          (f (floor final-steps width))
     50          (y0 (step-through-garden map start-pos target))
     51          (y1 (step-through-garden map start-pos (+ width target)))
     52          (y2 (step-through-garden map start-pos (+ (* width 2) target)))
     53          (b0 y0)
     54          (b1 (- y1 y0))
     55          (b2 (- y2 y1)))
     56     (+ (* (* f (/ (1- f) 2)) (- b2 b1)) (* b1 f) b0)))
     57 
     58 (defun day-21 (input &optional (steps-1 64) (steps-2 26501365))
     59   (let* ((map (make-map input))
     60          (start-pos (find-start-position map)))
     61     (values (step-through-garden map start-pos steps-1)
     62             (task-2 map start-pos steps-2))))