day16

1 files changed, 112 insertions, 0 deletions

diff --git a/day16.lisp b/day16.lisp
new file mode 100644
index 0000000..5643690
--- /dev/null
+++ b/day16.lisp
@@ -0,0 +1,112 @@
+(defun read-map (filespec)
+  (with-open-file (stream filespec)
+    (let ((lines (loop for line = (read-line stream nil) while line collect line)))
+      (make-array (list (length lines) (length (first lines))) :initial-contents lines))))
+
+(defun next-pos-right (pos map)
+  (let* ((i (car pos))
+         (j (cdr pos))
+         (n (array-dimension map 0))
+         (m (array-dimension map 1))
+         (c (aref map i j)))
+    (cond
+      ((equal c #\/) (unless (= i 0) (list (cons (cons (1- i) j) #\U))))
+      ((equal c #\\) (unless (= (1+ i) n) (list (cons (cons (1+ i) j) #\D))))
+      ((equal c #\|) (cond ((and (> i 0) (< (1+ i) n))
+                            (list (cons (cons (1- i) j) #\U)
+                                  (cons (cons (1+ i) j) #\D)))
+                           ((> i 0) (list (cons (cons (1- i) j) #\U)))
+                           ((< (1+ i) n) (list (cons (cons (1+ i) j) #\D)))))
+      (t (unless (= (1+ j) m) (list (cons (cons i (1+ j)) #\R)))))))
+
+;; Could reduce reptition from above by merging functions
+(defun next-pos-left (pos map)
+  (let* ((i (car pos))
+         (j (cdr pos))
+         (n (array-dimension map 0))
+         (c (aref map i j)))
+    (cond
+      ((equal c #\\) (unless (= i 0) (list (cons (cons (1- i) j) #\U))))
+      ((equal c #\/) (unless (= (1+ i) n) (list (cons (cons (1+ i) j) #\D))))
+      ((equal c #\|) (cond ((and (> i 0) (< (1+ i) n))
+                            (list (cons (cons (1- i) j) #\U)
+                                  (cons (cons (1+ i) j) #\D)))
+                           ((> i 0) (list (cons (cons (1- i) j) #\U)))
+                           ((< (1+ i) n) (list (cons (cons (1+ i) j) #\D)))))
+      (t (unless (= j 0) (list (cons (cons i (1- j)) #\L)))))))
+
+(defun next-pos-up (pos map)
+  (let* ((i (car pos))
+         (j (cdr pos))
+         (m (array-dimension map 1))
+         (c (aref map i j)))
+    (cond
+      ((equal c #\/) (unless (= (1+ j) m) (list (cons (cons i (1+ j)) #\R))))
+      ((equal c #\\) (unless (= j 0) (list (cons (cons i (1- j)) #\L))))
+      ((equal c #\-) (cond ((and (> j 0) (< (1+ j) m))
+                            (list (cons (cons i (1- j)) #\L)
+                                  (cons (cons i (1+ j)) #\R)))
+                           ((> j 0) (list (cons (cons i (1- j)) #\L)))
+                           ((< (1+ j) m) (list (cons (cons i (1+ j)) #\R)))))
+      (t (unless (= i 0) (list (cons (cons (1- i) j) #\U)))))))
+
+(defun next-pos-down (pos map)
+  (let* ((i (car pos))
+         (j (cdr pos))
+         (n (array-dimension map 0))
+         (m (array-dimension map 1))
+         (c (aref map i j)))
+    (cond
+      ((equal c #\\) (unless (= (1+ j) m) (list (cons (cons i (1+ j)) #\R))))
+      ((equal c #\/) (unless (= j 0) (list (cons (cons i (1- j)) #\L))))
+      ((equal c #\-) (cond ((and (> j 0) (< (1+ j) m))
+                            (list (cons (cons i (1- j)) #\L)
+                                  (cons (cons i (1+ j)) #\R)))
+                           ((> j 0) (list (cons (cons i (1- j)) #\L)))
+                           ((< (1+ j) m) (list (cons (cons i (1+ j)) #\R)))))
+      (t (unless (= (1+ i) n) (list (cons (cons (1+ i) j) #\D)))))))
+
+(defun next-pos (pos dir map)
+  (cond ((equal dir #\R) (next-pos-right pos map))
+        ((equal dir #\L) (next-pos-left pos map))
+        ((equal dir #\U) (next-pos-up pos map))
+        ((equal dir #\D) (next-pos-down pos map))))
+
+(defun solve (map &optional (start '((0 . 0) . #\R)))
+  (let ((visited (make-hash-table :test #'equal))
+        (visited2 (make-hash-table :test #'equal)))
+    (loop for ray = start then (car stack)
+          for stack = () then (cdr stack)
+          while ray
+          as pos = (car ray)
+          as dir = (cdr ray)
+          sum (if (gethash pos visited) 0 (setf (gethash pos visited) 1))
+          do (unless (gethash ray visited2)
+               (setf (gethash ray visited2) 1)
+               (loop for r in (next-pos pos dir map) do (setf stack (cons r stack)))))))
+  
+
+(defun solve1 (filespec)
+  (solve (read-map filespec)))
+
+;; Could possibly be optimized by merging sets of visited tiles from
+;; each position/direction. But this is fast enough
+(defun solve2 (filespec)
+  (let* ((map (read-map filespec))
+         (n (array-dimension map 0))
+         (m (array-dimension map 1)))
+    (max
+     (loop for i below n
+           maximize (max (solve map (cons (cons i 0) #\R))
+                         (solve map (cons (cons i (1- m)) #\L))))
+     (loop for j below m
+           maximize (max (solve map (cons (cons 0 j) #\D))
+                         (solve map (cons (cons (1- n) j) #\U)))))))
+
+(print (solve1 "data/16/example.txt")) ;; 46
+(print (solve1 "data/16/input.txt"))   ;; 7046
+(print (solve2 "data/16/example.txt")) ;; 51
+(print (solve2 "data/16/input.txt"))   ;; 7313
+
+
+