advent-2024/p16/p16.org

Solution to p16

Load map

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

and split into a list of list of chars

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

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

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

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 +nil (a b) ;we only need a binary operator
    (when (not ))
    )

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

In principle the above would work as-is, but we add some bailout strategy. We record somewhere the smallest score so far. If we are beyond the smallest score there is no point proceeding any further

  (setq min-score nil)

  (defun explore-bailout (p dir &optional score 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"
  (when (or (not min-score) (< score min-score))
   (if (eq (thing-at p) 'end) (setq min-score (-min (-non-nil (list score min-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)))
         (-each acceptable-dirs (lambda (newdir)
                     (explore-bailout (neighbour p newdir) newdir
                              (+ score (if (equal newdir dir) 1 1001))
                              (cons p past)))))))))

  (explore-bailout start '(1 0) 0)
  min-score

11048