advent-2024/p15/p15.part2.org

Solution to p15 part 2

Rather than modifying the other file it makes sense to create a new one this time

Process the input file to create the maps and the sequence of moves

  (require 'dash)
  (with-temp-buffer
      (insert-file-contents "input")
      (goto-char (point-min))
      (replace-regexp "^\\(#.*#\\)$" "\"\\1\"")
      (goto-char (point-min))
      (replace-regexp "#" "##")
      (goto-char (point-min))
      (replace-regexp "\\." "..")
      (goto-char (point-min))
      (replace-regexp "O" "[]")
      (goto-char (point-min))
      (replace-regexp "@" "@.")
      (goto-char (point-min))
      (insert "(setq map '(")
      (goto-char (point-min))
      (replace-regexp "^$" ")\n commands '(")
      (goto-char (point-min))
      (replace-regexp "<" "( -1 0)")
      (goto-char (point-min))
      (replace-regexp ">" "( 1 0)")
      (goto-char (point-min))
      (replace-regexp "v" "( 0 1)")
      (goto-char (point-min))
      (replace-regexp "\\^" "( 0 -1)")
      (goto-char (point-max))
      (insert "))")
      (eval-buffer))

Read and parse the map to extract the positions of the various elements

  (setq map-things (-map
            (lambda (str) (-map #'string-to-char (split-string
                              str "\\|.+" t)))
            map)
    height (length map-things)
    width (length (car map-things)))

  (defun coordinates-of (e)
    (-map #'cadr
      (--filter (eq (car it) e)
            (-mapcat #'identity
                 (-map-indexed (lambda (y l)
                         (-map-indexed (lambda (x el) (list el (list x y))) l))

                        map-things)))))

  (setq walls (coordinates-of ?#)
    l-crates (coordinates-of ?[)
    r-crates (coordinates-of ?])
    robot (car (coordinates-of ?@)))

  (setq buddies-alist '((l-crate . (1 0))
                        (r-crate . (-1 0))
                        (robot . nil)))

Implement the move logic. The key function is try-move: it tries to move stuff in some direction and push anything it can along the way by calling itself recursively to see if whatever is on the way can itself be pushed.

  (defun thing-at (p)
    "Returns which object (if any) is present at position P"
    (cond
     ((equal p robot) 'robot)
     ((-contains-p walls p) 'wall)
     ((-contains-p l-crates p) 'l-crate)
     ((-contains-p r-crates p) 'r-crate)
     (t nil)))

  (defun neighbour (p dir)
    "Returns the neighbour to P in the direction DIR"
    (list (+ (car p) (car dir))
      (+ (cadr p) (cadr dir))))

  (defun do-move (from to)
    "Updates the content of the warehouse by moving whatever is at
  FROM to the position TO"
    (cond
     ((eq (thing-at from) 'l-crate) (setq l-crates (-replace from to l-crates)))
     ((eq (thing-at from) 'r-crate) (setq r-crates (-replace from to r-crates)))
     (t (setq robot to))))

  (defun try-move (p dir &optional pretend no-buddy-check)
    "Try to move the object at P in the direction DIR.  This moves
   both halves of a crate together. just pretend to move if PRETEND is non-nil"
    (let ((thing (thing-at p)))
      (cond
       ((not thing) t)
       ((eq thing 'wall) nil)
       (t (let* ((dest (neighbour p dir))
                 (buddy-dir (when (eq 0 (car dir))
                              (cdr (assoc thing buddies-alist))))
                 (buddy (when buddy-dir (neighbour p buddy-dir))))
            (when (and (try-move dest dir pretend)
                       (or no-buddy-check (try-move buddy dir pretend t)))
              (or pretend (do-move p dest))))))))

This is just to make pretty pictures of the current state

  (defun make-bg ()
    (insert (apply #'concat (-repeat height (concat (concat (-repeat width ?. )) "\n")))))

  (defun plot (p s)
    (goto-line (+ (cadr p) 1))
    (move-to-column (car p))
    (insert s)
    (delete-char 1))

  (defun save-pic ()
    (with-temp-buffer
      (make-bg)
      (--map (plot it "#") walls); should use --each
      (--map (plot it "[") l-crates)
      (--map (plot it "]") r-crates)

      (plot robot "@")
      (write-file "test-out")))

Finally, implement the moves and compute the result for part 2

  (--map (and (try-move robot it t) (try-move robot it)) commands)
  (-reduce #'+ (--map (+ (car it) (* 100 (cadr it))) l-crates))

1392847