Some more progress p16

p16/p16.org

@@ -4,7 +4,7 @@ Load map
 #+begin_src emacs-lisp :results none
   (require 'dash)
   (with-temp-buffer
-      (insert-file-contents "input-test")
+      (insert-file-contents "input-test2")
       (goto-char (point-min))
       (replace-regexp "^\\(#.*#\\)$" "\"\\1\"")
       (goto-char (point-min))
@@ -12,15 +12,17 @@ Load map
       (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)))
 
+  (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)))
 
@@ -32,8 +34,6 @@ and split into a list of list of chars
   (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
@@ -57,10 +57,6 @@ associated scores;
     (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
@@ -79,30 +75,45 @@ associated scores;
   (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
+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
 #+begin_src emacs-lisp
-  (setq min-score nil)
+  (defun >nil (a b)
+    (when b
+      (or (not a) (> a b))))
+
+  (defun subtract-nil (a b)
+    (when (and a b)
+      (- a b)))
+
+  (defun +nil (a b)
+    (when (and a b)
+      (+ a b)))
+
+  (defun neighbour-maybe (p dir newdir)
+    (if (not (equal dir newdir)) p
+      (neighbour p newdir)))
 
-  (defun explore-bailout (p dir &optional score past)
-  "Explore the maze starting at position P and in the direction
+  (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"
-  (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
+    (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
+       (unless (-contains-p (cdr 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))
+                (new-score (-min-by #'>nil (-map (lambda (newdir)
+                                                   (explore (neighbour-maybe p dir newdir) newdir
+                                                            (+ score (if (equal newdir dir) 1 1000))
+                                                            (cons p past)))
+                                                 acceptable-dirs))))
+           (push (cons (list p dir) (subtract-nil new-score score)) book)
+           new-score)))))
+
+  (setq book nil)
+  (explore start '(1 0) 0)
+  #+end_src
 
 #+RESULTS:
 : 11048