(ql:quickload '(fiveam uiop trivia arrows))


(defun distance-1 (a b)
  (apply #'+
         (mapcar (lambda (e1 e2)
                   (abs (- e1 e2))) a b)))

(defun boundary-conditions (width height)
  "The boundary is a wall meaning 0 & (N-1) are never occupied."
  (lambda (x y dir)
    (list
     dir
     (cond
       ((zerop x) (- width 2))
       ((= x (- width 1)) 1)
       (x))
     (cond
       ((zerop y) (- height 2))
       ((= y (- height 1)) 1)
       (y)))))

(defun wall-p (width height)
  (lambda (point)
    (destructuring-bind (x y) point
      (cond
        ;; not entry - exit
        ((or (and (= x 1) (zerop y))
             (and (= x (- width 2)) (= y (1- height))))
         nil)
        ;; yes wall or out of map
        ((or (<= x 0) (<= y 0)
             (>= x (1- width))
             (>= y (1- height))))))))

(fiveam:test boundaries
  (let ((bc (boundary-conditions 6 9)))
    (fiveam:is (equal (funcall bc 5 3 t) '(1 3 t)))
    (fiveam:is (equal (funcall bc 5 8 t) '(1 1 t)))
    (fiveam:is (equal (funcall bc 0 8 t) '(4 1 t)))))

(defun data-input (filename)
  (let ((lines (uiop:read-file-lines filename)))
    (list
     (loop for row in lines
           and y from 0
           nconc (loop for place across row
                       and x from 0
                       unless (or (eq #\# place) (eq #\. place))
                         collect (list (ecase place
                                         (#\> '>)
                                         (#\< '<)
                                         (#\v 'v)
                                         (#\^ '^))
                                       x y)))
     (list (length (car lines))
           (length lines)))))

(defun evolve (blizzards boundary)
  (mapcar
   (lambda (blizzard)
     (trivia:match blizzard
       ((list '> x y) (funcall boundary (1+ x) y '>))
       ((list '< x y) (funcall boundary (1- x) y '<))
       ((list 'v x y) (funcall boundary x (1+ y) 'v))
       ((list '^ x y) (funcall boundary x (1- y) '^))))
   blizzards))


(defun elf-moves (elf wallp blizzards)
  (destructuring-bind (x y) elf
    (arrows:-<>
     (list (list (1+ x)    y)
           (list x     (1+ y))
           (list (1- x)    y)
           (list x     (1- y))
           (list x         y))
     (delete-if wallp <>)
     (set-difference <> (mapcar #'cdr blizzards) :test #'equal))))

(defun cutoff-distance (positions goal)
  (loop for p in positions
        for dist = (distance-1 goal p)
        maximize dist into ma
        minimize dist into mi
        finally (return (values (max (ceiling (+ ma mi) 2)
                                     (* 1.2 mi)
                                     (* 0.8 ma)
                                     30)
                                mi ma))))

(defun discard-hopeless-positions (positions goal cutoff-distance)
  (delete-if (lambda (p) (< cutoff-distance (distance-1 goal p))) positions))

(defun time-step (time-left walkers goal blizzards bc wallp)
  (if (or (zerop time-left) (member goal walkers :test #'equal))
      (values time-left blizzards)
      (let* ((new-blizzards (evolve blizzards bc))
             (new-positions (reduce
                             (lambda (options point)
                               (union options (elf-moves point wallp new-blizzards)
                                      :test #'equal))
                             walkers
                             :initial-value nil))
             (shortened-positions (discard-hopeless-positions new-positions goal
                                               (cutoff-distance new-positions goal))))
        (time-step (1- time-left)
                   shortened-positions
                   goal new-blizzards bc wallp))))

(destructuring-bind (blizzards (width height)) (data-input "input")
  (let ((bc (boundary-conditions width height))
        (wallp (wall-p width height))
        (goal (list (- width 2) (1- height)))
        (elf (list 1 0))
        (max-time 400))
    (multiple-value-bind (time-left-g blizzards) (time-step max-time (list elf) goal blizzards bc wallp)
      (multiple-value-bind (time-left-b blizzards) (time-step max-time (list goal) elf blizzards bc wallp)
        (multiple-value-bind (time-left-e blizzards) (time-step max-time (list elf) goal blizzards bc wallp)
          (list (- max-time time-left-g)
                (- max-time time-left-b)
                (- max-time time-left-e)))))

    )

  )
(+ 299 348 252)
(+ 299 323 277)