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.
108 lines
3.5 KiB
108 lines
3.5 KiB
#+title: Solution to p16 |
|
|
|
Load map |
|
#+begin_src emacs-lisp :results none |
|
(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)) |
|
#+end_src |
|
|
|
and split into a list of list of chars |
|
#+begin_src emacs-lisp :results none |
|
(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))) |
|
#+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 +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) |
|
#+end_src |
|
|
|
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 |
|
#+begin_src emacs-lisp |
|
(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 |
|
#+end_src |
|
|
|
#+RESULTS: |
|
: 11048
|
|
|