[AoC2022] Elisp Day 12-01 eg depth-first

1 files changed, 75 insertions, 0 deletions

diff --git a/AoC2022/12/solver.el b/AoC2022/12/solver.el
new file mode 100644
index 0000000..44fe525
--- /dev/null
+++ b/AoC2022/12/solver.el
@@ -0,0 +1,75 @@
+;;; solver.el --- Day 12 -*- lexical-binding: t; -*-
+;;
+;; Copyright (C) 2022 Óscar Nájera
+;;
+;; Author: Óscar Nájera <hi@oscarnajera.com>
+;; Maintainer: Óscar Nájera <hi@oscarnajera.com>
+;; Created: December 12, 2022
+;; Modified: December 12, 2022
+;;
+;; This file is not part of GNU Emacs.
+;;
+;;; Commentary:
+;;
+;;  Day 12
+;;
+;;; Code:
+
+(require 'ert)
+
+(defun solver-directions (pos width height)
+  ;; point on grid is p=x+y*width
+  (let ((x (mod pos width))
+        (y (/ pos width)))
+    (delq nil
+          (list
+           (when (< -1 x  (1- width)) (1+ pos))      ;; right move
+           (when (<  0 x width) (1- pos))            ;; left move
+           (when (< -1 y (1- height)) (+ pos width)) ;; down 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)))
+
+(defun solver-land (data)
+  (vconcat (mapconcat (lambda (row)
+                        (cl-map 'string (lambda (chr)
+                                          (cl-case chr
+                                            (?S 0)
+                                            (?E 27)
+                                            (t (- chr 96))))
+                                row))
+                      data "")))
+
+(defun solver-search (path land)
+  (let* ((pos (car path))
+         (elevation (aref land pos))
+         (next-cells (solver-directions pos width height)))
+    (if (= 27 elevation) ;; reached destination
+        (list (reverse path))
+      (mapcan (lambda (option)
+                (when (and (not (memq option path))
+                           (>= (1+ elevation) (aref land option))) ;; allowed move
+                  (solver-search (cons option path) land)))
+              next-cells))))
+
+(with-temp-buffer
+  (insert "Sabqponm
+abcryxxl
+accszExk
+acctuvwj
+abdefghi")
+  (let* ((data (split-string (buffer-string) "\n"))
+         (height (length data))
+         (width (length (car data)))
+         (land (solver-land data))
+         (start (seq-position land 0 #'eq)))
+    (thread-first
+      (cl-sort
+       (solver-search (list start) land)
+       #'<
+       :key #'length)
+      (car)
+      (length)
+      (1-))
+    ))