path: root/day16.lisp

(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