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

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

  (defun print-map (p)
    (with-temp-buffer
      (-each data (lambda (x) (insert x) (insert "\n")))
      (-each book (lambda (x) (if (cdr x) (plot (caar x) ?x)
                                (plot (caar x) ?!))))
      (plot p ?@)
      (write-file "tmp")) )

print-map

In principle the above would work as-is, but it is not very efficient. In the version below, we record dead-ends and partial solutions

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

  (defun subtract-nil (a b)
    (when (and (numberp a) (numberp b))
      (- a b)))

  (defun +nil (a b)
    (when (and (numberp a) (numberp b))
      (+ a b)))

  (defun neighbour-maybe (p dir newdir)
    (if (not (equal dir newdir)) p
      (neighbour p newdir)))

  (defun forward-dirs (dir olddir)
    (if (not (equal dir olddir)) (list dir)
      (cons dir (--filter (= (dot it dir) 0) '((0 1) (0 -1) (-1 0) (1 0))))))

  (defun explore (p dir old-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
      (if (assoc (list p dir) book) (+nil score (cdr (assoc (list p dir) book))) ; check the book for this position and direction
        (if (-contains-p (cdr past) p) 'loop
          (let* ((acceptable-dirs (--filter (not (eq (thing-at (neighbour p it)) 'wall)) (forward-dirs dir old-dir)))
                 (new-score (-min-by #'>nil (-map (lambda (newdir)
                                                    (explore (neighbour-maybe p dir newdir) newdir dir
                                                             (+ score (if (equal newdir dir) 1 1000))
                                                             (-distinct (cons p past))))
                                                  acceptable-dirs))))
            (when (not (eq new-score 'loop)) (push (cons (list p dir) (subtract-nil new-score score)) book))
            new-score)))))

    (setq book nil)
    (explore start '(1 0) '(1 0) 0)

11048

(print-map)