advent-of-code-2024

My solutions to AoC 2024
Log | Files | Refs

day-21.lisp (4126B)


      1 (defpackage #:aoc/day-21
      2   (:use #:cl #:aoc/utils)
      3   (:export #:day-21))
      4 (in-package #:aoc/day-21)
      5 
      6 (defparameter *keypad*
      7   (with-input-from-string (s "789
      8 456
      9 123
     10 #0A")
     11     (make-map s)))
     12 
     13 (defparameter *directional-pad*
     14   (with-input-from-string (s "#^A
     15 <v>")
     16     (make-map s)))
     17 
     18 (defparameter *directions* '((0 . -1) (1 . 0) (0 . 1) (-1 . 0)))
     19 
     20 (defun direction (dir)
     21   (eswitch (dir :test #'equal)
     22     ('(1 . 0) #\>)
     23     ('(-1 . 0) #\<)
     24     ('(0 . 1) #\v)
     25     ('(0 . -1) #\^)))
     26 
     27 (defun dfs (map start end width height max)
     28   (loop with stack = (list (list start nil 0))
     29         with possible-paths = nil
     30         for (pos dirs length) = (pop stack)
     31         when (null pos)
     32           do (return possible-paths)
     33         when (equal pos end)
     34           do (push (reverse dirs) possible-paths)
     35         when (< length max)
     36           do (loop for dir in *directions*
     37                    for next = (point+ pos dir)
     38                    when (and (point-in-bounds-p next width height)
     39                              (char/= (map-cell map next) #\#))
     40                      do (push (list next (cons (direction dir) dirs) (1+ length)) stack))))
     41 
     42 (defun build-arm-movements-cache (map)
     43   (loop with cache = (make-hash-table :test #'equal)
     44         with width = (input-map-width map)
     45         with height = (input-map-height map)
     46         for y-1 from 0 below height
     47         do (loop for x-1 from 0 below width
     48                  for p-1 = (cons x-1 y-1)
     49                  for c-1 = (map-cell map p-1)
     50                  unless (char= c-1 #\#)
     51                    do (loop for y-2 from 0 below height
     52                             do (loop for x-2 from 0 below width
     53                                      for p-2 = (cons x-2 y-2)
     54                                      for c-2 = (map-cell map p-2)
     55                                      for max-distance = (manhattan-distance p-1 p-2)
     56                                      unless (or (char= c-2 #\#)
     57                                                 (char= c-1 c-2))
     58                                        do (setf (gethash (cons c-1 c-2) cache)
     59                                                 (dfs map p-1 p-2 width height max-distance)))))
     60         finally (return cache)))
     61 
     62 (defparameter *keypad-movements* (build-arm-movements-cache *keypad*))
     63 (defparameter *directional-pad-movements* (build-arm-movements-cache *directional-pad*))
     64 
     65 (defun all-possibilities (buttons cache)
     66   (loop with all-possibilities = nil
     67         with last = #\A
     68         for button in buttons
     69         for possibilities = (gethash (cons last button) cache)
     70         if possibilities
     71           do (push (mapcar (rcurry #'append '(#\A)) possibilities) all-possibilities)
     72         else
     73           do (push '((#\A)) all-possibilities)
     74         do (setf last button)
     75         finally (return (nreverse all-possibilities))))
     76 
     77 (defun make-robot (next movements-map)
     78   (let ((cache (make-hash-table :test #'equal)))
     79     (lambda (sequence)
     80       (loop for possibilities in (all-possibilities sequence movements-map)
     81             sum (loop for possibility in possibilities
     82                       minimize (or (gethash possibility cache)
     83                                    (setf (gethash possibility cache)
     84                                          (funcall next possibility))))))))
     85 
     86 (defun make-robots (n-robots)
     87   (loop with current = (make-robot #'length *directional-pad-movements*)
     88         for i from 1 to n-robots
     89         do (setf current (make-robot current (if (= i n-robots)
     90                                                  *keypad-movements*
     91                                                  *directional-pad-movements*)))
     92         finally (return current)))
     93 
     94 (defun day-21 (input)
     95   (loop with task-1-robots = (make-robots 2)
     96         with task-2-robots = (make-robots 25)
     97         for line = (read-line input nil)
     98         until (null line)
     99         for buttons = (coerce line 'list)
    100         for numeric-value = (parse-integer line :junk-allowed t)
    101         sum (* (funcall task-1-robots buttons) numeric-value) into task-1
    102         sum (* (funcall task-2-robots buttons) numeric-value) into task-2
    103         finally (return (values task-1 task-2))))