From 53e7d842f2fda69d905defd9d046c281ef2dc2f4 Mon Sep 17 00:00:00 2001 From: Adrian Braemer <11058200+NobodysHero@users.noreply.github.com> Date: Wed, 9 Jan 2019 18:34:11 +0100 Subject: [PATCH] Day 22 Added the solution for day 22 and added a pretty general implementation of Dijkstra's algorithm to utilities.lisp. --- advent-of-code-2018.asd | 1 + day22.lisp | 75 +++++++++++++++++++++++++++++++++++++++++ utilities.lisp | 24 +++++++++++++ 3 files changed, 100 insertions(+) create mode 100644 day22.lisp diff --git a/advent-of-code-2018.asd b/advent-of-code-2018.asd index 18e80af..e009706 100644 --- a/advent-of-code-2018.asd +++ b/advent-of-code-2018.asd @@ -29,6 +29,7 @@ (:file "day19") (:file "day20") (:file "day21") + (:file "day22") (:file "day23") (:file "day25"))) diff --git a/day22.lisp b/day22.lisp new file mode 100644 index 0000000..e9f5ab1 --- /dev/null +++ b/day22.lisp @@ -0,0 +1,75 @@ +;;;; day22.lisp + +(in-package :advent-of-code-2018) + +(defun day22-parse-input () + (mapcar #'extract-integers (read-puzzlefile "input22.txt"))) + +(defun day22-generate-cave (width height cave-depth &optional (target-x 0) (target-y 0)) + "Generates the cave." + (let ((indices (make-array (list (1+ width) (1+ height)) :element-type '(mod 20183)))) + ;; compute the geological indices + (loop :for x :from 0 :upto width + :do (setf (aref indices x 0) (mod (+ cave-depth (* x 16807)) 20183))) + (loop :for y :from 0 :upto height + :do (setf (aref indices 0 y) (mod (+ cave-depth (* y 48271)) 20183))) + (loop :for y :from 1 :upto height + :do (loop :for x :from 1 :upto width + :when (and (= x target-x) (= y target-y)) + :do (setf (aref indices x y) 0) + :else :do (setf (aref indices x y) + (mod + (+ cave-depth + (* (aref indices (1- x) y) + (aref indices x (1- y)))) + 20183)))) + ;; take mod 3 for type + (loop :with cave := (make-array (list (1+ width) (1+ height)) :element-type '(mod 3)) + :for i :from 0 :below (array-total-size indices) + :do (setf (row-major-aref cave i) (mod (row-major-aref indices i) 3)) + :finally (return cave)))) + +;;for debugging +(defun day22-print-cave (cave) + "Used for debugging. Displayes the cave as seen on the AoC website." + (loop :for y :below (array-dimension cave 1) + :do (format t "~{~a~}~%" (loop for x :below (array-dimension cave 0) + :collect (case (mod (aref cave x y) 3) + (0 #\.) + (1 #\=) + (2 #\|) + (t #\x)))))) + +(defun day22-shortest-path (cave target-x target-y) + "Finds the shortest path from the 0,0 coordinate to the target's coordinate. The torch is equipped at the start and end." + (flet ((neighbours (a) + ;;neighbours are either displaced 1 coordinate step or change gear + (destructuring-bind (x y gear) a + (loop :for (dx dy) :in '((-1 0) (1 0) (0 -1) (0 1)) + :for nx := (+ dx x) + :for ny := (+ dy y) + :when (and (array-in-bounds-p cave nx ny) + (not (= gear (aref cave nx ny)))) + :collect (list nx ny gear) :into neighbours + ;append gear change to the neighbours and return + :finally (return (cons (list x y (first (delete gear (delete (aref cave x y) (list 0 1 2))))) + neighbours))))) + (distance (a b) + (let ((from-gear (third a)) + (target-gear (third b))) + (if (= target-gear from-gear) 1 7)))) + (second (multiple-value-list (dijkstra '(0 0 1) + (list target-x target-y 1) + #'distance + #'neighbours + :test 'equalp))))) + +(defun day22 () + (destructuring-bind ((depth) (target-x target-y)) (day22-parse-input) + (let ((cave (day22-generate-cave (+ 40 target-x) (+ 40 target-y) depth target-x target-y))) + (format t "The total risk index is: ~a~%" + (loop :for x :upto target-x + :sum (loop :for y :upto target-y + :sum (aref cave x y)))) + (format t "The quickest path to the target takes ~a minutes.~%" + (day22-shortest-path cave target-x target-y))))) diff --git a/utilities.lisp b/utilities.lisp index eac0781..444d7aa 100644 --- a/utilities.lisp +++ b/utilities.lisp @@ -101,3 +101,27 @@ ("(-?\\d+)" str) (push int list)) list))) + +(defun dijkstra (start end distance-function neighbour-function &key (test 'eql)) + "Finds the shortest path from the start node to the end node. The neighbour-function should return a proper list of nodes adjacent to the given node. The distance-function should return a non-negative distance between the given node." + (loop :with open := (make-instance 'cl-heap:fibonacci-heap :key #'first) + :with closed := (make-hash-table :test test) + :initially (dolist (n (funcall neighbour-function start)) + (cl-heap:add-to-heap open + (list (funcall distance-function start n) n start))) + (setf (gethash start closed) (cons 0 nil)) + :while (> (cl-heap:heap-size open) 0) + :until (gethash end closed nil) + :for (distance node prior) := (cl-heap:pop-heap open) + ;; explore the node if not explored yet + :unless (gethash node closed nil) :do + (setf (gethash node closed) (cons distance prior)) + (dolist (neighbour (funcall neighbour-function node)) + (unless (gethash neighbour closed nil) + (cl-heap:add-to-heap open (list (+ distance (funcall distance-function node neighbour)) + neighbour node)))) + ;; reconstruct the path + :finally (loop :with path := nil + :for at := end :then (rest (gethash at closed)) :while at + :do (push at path) + :finally (return-from dijkstra (values path (first (gethash end closed)))))))