;;; solver.el --- Day 12 -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2022 Óscar Nájera ;; ;; Author: Óscar Nájera ;; Maintainer: Óscar Nájera ;; Created: December 12, 2022 ;; Modified: December 12, 2022 ;; ;; This file is not part of GNU Emacs. ;; ;;; Commentary: ;; ;; Day 12 ;; ;;; Code: (require 'ert) (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* ((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 (when (< -1 y (1- height)) (+ pos width)) ;; down move (when (< 0 x width) (1- pos)) ;; left move (when (< 0 y height) (- pos width)))))) ;; up move (ert-deftest test-directions () (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))) (should (equal (solver-directions 1 (land--create :width 8 :height 5)) '(2 9 0)))) (defun solver-land (data) (cl-map 'string (lambda (chr) (cl-case chr (?S 0) (?E 27) (t (- chr 96)))) (apply #'concat data))) (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 (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 paths) (when-let ((next (mapcan (lambda (place) (solver-next-steps place land paths)) queue))) (solver-search next land paths))) (defun solver-landscape (filename) (with-temp-buffer (insert "") (insert-file-contents filename) (let* ((data (split-string (buffer-string) "\n" t)) (height (length data)) (width (length (car data)))) (land--create :grid (solver-land data) :width width :height height)))) (defun solver (input-file start-p) (let* ((land (solver-landscape input-file)) (paths (make-hash-table :test #'eq)) (finish (seq-position (land-grid land) 27 #'eq)) (starts (cl-loop for i from 0 for el across (land-grid land) when (funcall start-p el) collect (progn (puthash i (list i) paths) i)))) (solver-search starts land paths) (1- (length (gethash finish paths))))) (ert-deftest test-solver () (should (= 31 (solver "eg-in" (lambda (el) (= el 0))))) (should (= 29 (solver "eg-in" (lambda (el) (<= el 1))))) (should (= 361 (solver "input" (lambda (el) (= el 0))))) (should (= 354 (solver "input" (lambda (el) (<= el 1))))))