advent-2024/p16/p16.org

Solution to p16

Load map

  (require 'dash)
  (with-temp-buffer
      (insert-file-contents "input")
      (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))))

Now, explore the maze; this function returns a list of paths and the associated scores;

  (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

  (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")))
      (insert (format "min-score: %d" (caddr (car start-list))))
      (-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")) )

print-map

276920

The above does not work for some reasons I do not fully understand. Let me 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 ortho-dirs (dir)
    (--filter (= (dot it dir) 0) '((0 1) (0 -1) (-1 0) (1 0))))

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

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

  (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-ortho-dirs (--filter (acceptable-p p it) (ortho-dirs dir))))
        (push p book)
        (-concat (--map (list (neighbour p it) it (+ score 1001)) acceptable-ortho-dirs)
                 (when (acceptable-p p dir) (list (list (neighbour p dir) dir (1+ score))))))))

  (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)))

81448

72432

  (setq start-list (-concat (explore (car start-list)) (cdr  start-list)))
  (print-map)
  (setq start-list (-sort #'sort-vecs start-list))

(4 11)	(1 0)	2005
(2 9)	(1 0)	2005
(3 10)	(0 -1)	3005

scores (print-map)