You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
163 lines
4.7 KiB
163 lines
4.7 KiB
#+title: Solution to p16 |
|
|
|
Load map |
|
#+begin_src emacs-lisp :results none |
|
(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))) |
|
#+end_src |
|
|
|
and split into a list of list of chars |
|
#+begin_src emacs-lisp :results none |
|
(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))) |
|
#+end_src |
|
|
|
Define some aux functions |
|
#+begin_src emacs-lisp :results none |
|
(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)))) |
|
#+end_src |
|
|
|
Now, explore the maze; this function returns a list of paths and the |
|
associated scores; |
|
#+begin_src emacs-lisp |
|
(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) |
|
#+end_src |
|
|
|
For debugging, print the map |
|
#+begin_src emacs-lisp |
|
(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")) ) |
|
#+end_src |
|
|
|
#+RESULTS: |
|
: print-map |
|
|
|
|
|
|
|
#+prior RESULTS: |
|
: 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 |
|
#+begin_src emacs-lisp |
|
(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))) |
|
#+end_src |
|
|
|
#+results: |
|
|
|
#+RESULTS: |
|
| 81448 | 72432 | |
|
|
|
|
|
#+begin_src emacs-lisp |
|
(setq start-list (-concat (explore (car start-list)) (cdr start-list))) |
|
(print-map) |
|
(setq start-list (-sort #'sort-vecs start-list)) |
|
#+end_src |
|
|
|
#+RESULTS: |
|
| (4 11) | (1 0) | 2005 | |
|
| (2 9) | (1 0) | 2005 | |
|
| (3 10) | (0 -1) | 3005 | |
|
|
|
scores |
|
(print-map)
|
|
|