From c75d647ee47136853e3e180159d254569d3bba25 Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Mon, 12 Dec 2022 23:36:43 +0100
Subject: Now correctly without proliferating common paths

---
 AoC2022/12/solver.el | 83 +++++++++++++++++++++++-----------------------------
 1 file changed, 37 insertions(+), 46 deletions(-)

(limited to 'AoC2022/12/solver.el')

diff --git a/AoC2022/12/solver.el b/AoC2022/12/solver.el
index 1c68d04..4a8e149 100644
--- a/AoC2022/12/solver.el
+++ b/AoC2022/12/solver.el
@@ -17,10 +17,17 @@
 
 (require 'ert)
 
-(defun solver-directions (pos width height)
+(cl-defstruct (land (:constructor land--create)
+                      (:copier nil))
+  "Contaner for the land layout"
+  grid (width nil :read-only t) (height nil :read-only t))
+
+(defun solver-directions (pos land)
   ;; point on grid is p=x+y*width
-  (let ((x (mod pos width))
-        (y (/ pos width)))
+  (let* ((width (land-width land))
+         (height (land-height land))
+         (x (mod pos width))
+         (y (/ pos width)))
     (delq nil
           (list
            (when (< -1 x  (1- width)) (1+ pos))      ;; right move
@@ -28,8 +35,8 @@
            (when (<  0 x width) (1- pos))            ;; left move
            (when (<  0 y height) (- pos width)))))) ;; up move
 
-(should (equal (solver-directions 6 5 5) '(7 5 11 1)))
-(should (equal (solver-directions 0 5 5) '(1 5)))
+(should (equal (solver-directions 6 (land--create :width 5 :height 5)) '(7 11 5 1)))
+(should (equal (solver-directions 0 (land--create :width 5 :height 5)) '(1 5)))
 
 (defun solver-land (data)
   (vconcat (mapconcat (lambda (row)
@@ -41,52 +48,36 @@
                                 row))
                       data "")))
 
-(defun solver-next-steps (path land)
-  (let* ((pos (car path))
-         (elevation (aref land pos)))
-    (if (= 27 elevation) ;; reached destination
-        (list (vconcat (reverse path)))
+(defun solver-next-steps (pos land paths)
+  (let ((elevation (aref (land-grid land) pos)))
+    (unless (= 27 elevation) ;; reached destination
       (mapcan (lambda (option)
-                (when (and (not (memq option path))
-                           (>= (1+ elevation) (aref land option))) ;; allowed move
-                  (list (cons option path))))
-              (solver-directions pos width height)))))
-
+                (when (and (not (gethash option paths))
+                           (>= (1+ elevation) (aref (land-grid land) option))) ;; allowed move
+                  (puthash option (cons option (gethash pos paths)) paths)
+                  (list option)))
+              (solver-directions pos land)))))
 
-(defun solver-search (queue land)
 
-  (let* ((next (mapcan (lambda (path) (solver-next-steps path land)) queue))
-        (finish (seq-filter #'vectorp next)))
-    (cond
-     ((null next) "No solution")
-     ((null finish) (solver-search next land))
-     (finish))
-      ))
+(defun solver-search (queue land paths)
+  (when-let ((next (mapcan (lambda (place) (solver-next-steps place land paths)) queue)))
+      (solver-search next land paths)))
 
 (with-temp-buffer
-  (insert "Sabqponm
-abcryxxl
-accszExk
-acctuvwj
-abdefghi")
-  (let* ((data (split-string (buffer-string) "\n"))
+;;   (insert "Sabqponm
+;; abcryxxl
+;; accszExk
+;; acctuvwj
+;; abdefghi")
+  (insert-file-contents "input")
+  (let* ((data (split-string (buffer-string) "\n" t))
          (height (length data))
          (width (length (car data)))
-         (land (solver-land data))
-         (start (seq-position land 0 #'eq)))
-    ;; (solver-search
-    ;;  land)
-    (let ((res (solver-search (list (list start)) land)))
-      (list
-       (length res)
-       (mapcar #'length res))
-      )
+         (land (land--create :grid (solver-land data) :width width :height height))
+         (start (seq-position (land-grid land) 0 #'eq))
+         (finish (seq-position (land-grid land) 27 #'eq))
+         (paths (make-hash-table :test #'eq)))
+    (puthash start (list start) paths)
+    (solver-search (list start) land paths)
+    (1- (length (gethash finish paths)))
     ))
-
-(thread-first
-  (cl-sort
-   #'<
-   :key #'length)
-  (car)
-  (length)
-  (1-))
-- 
cgit v1.2.3