advent-2024/p16/p16.org

Solution to p16

Load map

  (require 'dash)
  (with-temp-buffer
      (insert-file-contents "input2")
      (goto-char (point-min))
      (replace-regexp "^\\(#.*#\\)$" "\"\\1\"")
      (goto-char (point-min))
      (insert "(setq data '(")
      (goto-char (point-max))
      (insert "))")
      (eval-buffer))

  (setq data-chars (-map (lambda (str) (--map (string-to-char it) (split-string str "\\|.+" t)))
             data)
      height (length data-chars)
      width (length (car data-chars)))

  (setq start (list 1 (- height 2)))

and split into a list of list of chars

  (defun char-at (p)
    (nth (car p) (nth (cadr p) data-chars)))

  (setq char-things-alist '((?# . wall)
                            (?. . free)
                            (?S . start)
                            (?E . end)))

  (defun thing-at (p)
      "Returns which object (if any) is present at position P"
      (cdr (assoc (char-at p) char-things-alist)))

Define some aux functions

  (setq max-lisp-eval-depth 1000000) ; burn baby burn

  (defun dot (a b)
    "Return the dot product of the two vectors"
    (-reduce #'+ (-map (lambda (x) (* (car x) (cdr x))) (-zip-pair a b))))

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

Thia is the naïve implementation. Explore the maze; this function returns a list of paths and the associated scores; it blows the stack on the actual input

  (defun >nil (a b)
    (when b
      (or (not a) (> a b))))

  (defun explore (p dir score &optional past)
    "Explore the maze starting at position P and in the direction
  DIR. Returns nil if we will dead-end or loop or the score
  if we reach the end"
    (if (eq (thing-at p) 'end) score
      (unless (-contains-p past p)	; loop
	(let* ((forward-dirs (--filter (>= (dot it dir) 0)
				       '((0 1) (0 -1) (-1 0) (1 0))))
	       (acceptable-dirs (--filter (not (eq (thing-at (neighbour p it)) 'wall)) forward-dirs)))
	  (-min-by #'>nil (-map (lambda (newdir)
				  (explore (neighbour p newdir) newdir
					   (+ score (if (equal newdir dir) 1 1001))
					   (cons p past)))
				acceptable-dirs))))))

  (explore start '(1 0) 0)

For debugging, print the map and some aux info

  (setq dir-alist '( ((1 0) . ?→)
                     ((-1 0). ?←)
                     ((0 -1). ?↑)
                     ((0 1) . ?↓)))

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

  (defun print-map (&optional p)
    (with-temp-buffer
      (-each data (lambda (x) (insert x) (insert "\n")))
      (-each book (lambda (x) (plot x ?X)))
      (-each start-list (lambda (x) (plot (car x) (cdr (assoc (cadr x) dir-alist)))))
      (when p (plot p ?@))
      (write-file "tmp")) )

Let us try with a different approach. Now we start from a point and a direction; we do one round of explorations and end up with a list of starting points, directions and accumulated scores. we stop at each turn

  (setq start-vector (list start '(1 0) 0)) ; starting point, direction and score

  (defun next-dirs (dir)
    (--filter (>= (dot it dir) 0) '((0 1) (0 -1) (-1 0) (1 0))))

  (defun acceptable-p (p dir)
    (not (eq (thing-at (neighbour p dir)) 'wall)))

  (defun sort-vecs (a b)
    (< (caddr a) (caddr b)))

  (defun delta-score (olddir newdir)
    (if (equal olddir newdir) 1 1001))

  (defun explore (start-vect)
    (if (eq (thing-at (car start-vect)) 'end) (progn (push (caddr start-vect) scores) nil)
      (let* ((p (car start-vect))
	     (dir (cadr start-vect))
	     (score (caddr start-vect))
	     (acceptable-next-dirs (--filter (acceptable-p p it) (next-dirs dir))))
	(unless (-contains-p book (list p dir))
	  (push (list p dir) book)
	  (--map (list (neighbour p it) it (+ score (delta-score it dir))) acceptable-next-dirs)))))

  (setq book nil
	scores nil)

  (setq start-list (list start-vector))
  (while  (setq start-list (-concat (explore (car start-list)) (cdr  start-list)))
    (setq start-list (-sort #'sort-vecs start-list)))
  scores

81444

72428

And this is for part 2. We find the "best" route and keep a pile of discarded routes. Routes can be discarded because they enter an area that another route has visited already, but they may give the same score. Hence at the end we look (recursively) in the discard pile and put the ones that end on the best paths with the same score in the best pile.

  (setq start-vector (list start '(1 0) 0)) ; starting point, direction and score

  (defun next-dirs (dir)
    (--filter (>= (dot it dir) 0) '((0 1) (0 -1) (-1 0) (1 0))))

  (defun acceptable-p (p dir)
    (not (eq (thing-at (neighbour p dir)) 'wall)))

  (defun sort-vecs (a b)
    (< (caddar a) (caddar b)))

  (defun delta-score (olddir newdir)
    (if (equal olddir newdir) 1 1001))

  (defun explore (start-vects)
    (let ((start-vect (car start-vects)))
      (if (eq (thing-at (car start-vect)) 'end) (progn (push start-vects scores) nil)
        (let* ((p (car start-vect))
               (dir (cadr start-vect))
               (score (caddr start-vect))
               (acceptable-next-dirs (--filter (acceptable-p p it) (next-dirs dir))))
          (if (-contains-p book (list p dir)) (progn (push start-vects discard) nil)
            (push (list p dir) book)
            (--map (cons (list (neighbour p it) it (+ score (delta-score it dir))) start-vects) acceptable-next-dirs))))))

  (setq book nil
        scores nil
        discard nil)

  (setq start-list (list (list start-vector)))
  (while  (setq start-list (-concat (explore (car start-list)) (cdr  start-list)))
    (setq start-list (-sort #'sort-vecs start-list)))
  (let ((best (list (cadr scores)))
        (repechage t))
    (while repechage
      (setq repechage (-filter (lambda (candidate)
                                 (--any-p (-contains-p it (car candidate)) best))
                               discard))
      (setq best (-union repechage best)
            discard (-difference discard repechage)))
    (length (-distinct (--mapcat (-map #'car it) best))))

456