day-03.lisp

(in-package :advent.2019)

(defstruct (point (:conc-name) (:constructor point (x y))) x y)
(defstruct (segment (:conc-name)) from to)
(defstruct (hsegment (:constructor hsegment (from to)) (:include segment)))
(defstruct (vsegment (:constructor vsegment (from to)) (:include segment)))

(defun manhattan (p1 p2)
  (+ (abs (- (x p2) (x p1)))
     (abs (- (y p2) (y p1)))))

(defun segment (origin direction length)
  (flet ((make (hv factor)
           (let ((d (* factor length)))
             (ecase hv
               (:h (hsegment origin
                             (point (+ (x origin) d)
                                    (y origin))))
               (:v (vsegment origin
                             (point (x origin)
                                    (+ (y origin) d))))))))
    (ecase direction
      (:up (make :v -1))
      (:down (make :v +1))
      (:left (make :h -1))
      (:right (make :h +1)))))

(defun parse-trajectory (file)
  (collect 'vector
    (mapping ((line (scan-file file #'read-line)))
             (mapcar
              (let ((origin (point 0 0)))
                (lambda (s)
                  (let ((segment (segment origin
                                          (case (char s 0)
                                            (#\U :up)
                                            (#\L :left)
                                            (#\R :right)
                                            (#\D :down))
                                          (parse-integer s :start 1))))
                    (setf origin (to segment))
                    segment)))
              (ppcre:split #\, line)))))

(defvar *input* (parse-trajectory "~/tmp/advent/03.in"))

;; (subseq (elt *input* 0) 0 5)
;;
;; (#S(HSEGMENT :FROM #S(POINT :X 0 :Y 0) :TO #S(POINT :X 990 :Y 0))
;;  #S(VSEGMENT :FROM #S(POINT :X 990 :Y 0) :TO #S(POINT :X 990 :Y -803))
;;  #S(HSEGMENT :FROM #S(POINT :X 990 :Y -803) :TO #S(POINT :X 1767 :Y -803))
;;  #S(VSEGMENT :FROM #S(POINT :X 1767 :Y -803) :TO #S(POINT :X 1767 :Y -960))
;;  #S(HSEGMENT :FROM #S(POINT :X 1767 :Y -960) :TO #S(POINT :X 2396 :Y -960)))

(defun interval (v1 v2)
  (cond
    ((= v1 v2) v1)
    ((< v1 v2) (values v1 v2))
    (t nil)))

(defun vv-intersect (s1 s2)
  (and (= (x (from s1))
          (x (from s2)))
       (let ((x (x (from s1))))
         (multiple-value-bind (low high)
             (interval (max (y (from s1))
                            (y (from s2)))
                       (min (y (to s1))
                            (y (to s2))))
           (cond
             ((and low high)
              (vsegment (point x low)
                        (point x high)))
             (low (point  x low)))))))

(defun hh-intersect (s1 s2)
  (and (= (y (from s1))
          (y (from s2)))
       (let ((y (y (from s1))))
         (multiple-value-bind (low high)
             (interval (max (x (from s1))
                            (x (from s2)))
                       (min (x (to s1))
                            (x (to s2))))
           (cond
             ((and low high)
              (hsegment (make-point low y)
                        (make-point high y)))
             (low (point low y)))))))

(defun hv-intersect (hs vs)
  (flet ((coord-between (c1 c2 c)
           (multiple-value-bind (lo hi)
               (if (<= c1 c2) (values c1 c2) (values c2 c1))
             (and (<= lo c hi) c))))
    (when-let ((x (coord-between (x (from hs))
                                 (x (to hs))
                                 (x (from vs))))
               (y (coord-between (y (from vs))
                                 (y (to vs))
                                 (y (from hs)))))
      (point x y))))

;; (hv-intersect (hsegment (point 0 0)
;;                         (point 10 0))
;;               (vsegment (point 5 -10)
;;                         (point 5 10)))
;; #S(POINT :X 5 :Y 0)

(defgeneric intersect (s1 s2)
  (:method ((h1 hsegment) (h2 hsegment)) (hh-intersect h1 h2))
  (:method ((h hsegment) (v vsegment)) (hv-intersect h v))
  (:method ((v vsegment) (h hsegment)) (hv-intersect h v))
  (:method ((v1 vsegment) (v2 vsegment)) (vv-intersect v1 v2)))

;; day 3 - part 1

(defvar *intersections*
  (delete nil (map-product #'intersect (elt *input* 0) (elt *input* 1))))

(define-constant +zero+ (point 0 0) :test #'equalp)

(first (sort (mapcar (lambda (p) (manhattan +zero+ p))
                     *intersections*)
             #'<))

;; day 3 - part 2

(defgeneric steps (thing)
  (:method ((s hsegment)) (abs (- (x (from s)) (x (to s)))))
  (:method ((s vsegment)) (abs (- (y (from s)) (y (to s))))))

(defun count-steps (segments)
  (loop
     with hash = (make-hash-table :test #'equalp)
     and count = 0
     for s in segments
     do
       ;; store steps to beginning of segment
       (setf (gethash s hash) count)
       (incf count (steps s))
     finally (return hash)))

(defvar *steps* (map 'list #'count-steps *input*))

;; (subseq (alexandria:hash-table-alist (first *steps*)) 0 5)
;; ((#S(HSEGMENT :FROM #S(POINT :X 7188 :Y 867) :TO #S(POINT :X 7447 :Y 867))
;;   . 151085)
;;  (#S(VSEGMENT :FROM #S(POINT :X 7188 :Y 192) :TO #S(POINT :X 7188 :Y 867))
;;   . 150410)
;;  (#S(HSEGMENT :FROM #S(POINT :X 6251 :Y 192) :TO #S(POINT :X 7188 :Y 192))
;;   . 149473)
;;  (#S(VSEGMENT :FROM #S(POINT :X 6251 :Y 357) :TO #S(POINT :X 6251 :Y 192))
;;   . 149308)
;;  (#S(HSEGMENT :FROM #S(POINT :X 6892 :Y 357) :TO #S(POINT :X 6251 :Y 357))
;;     . 148667))

(defun hs-p-intersect (hs p)
  (and (= (y p) (y (from hs)))
       (<= (min (x (from hs))
                (x (to hs)))
           (x p)
           (max (x (from hs))
                (x (to hs))))
       (hsegment (from hs) (point (x p) (y p)))))

(defmethod intersect ((s hsegment) (p point)) (hs-p-intersect s p))
(defmethod intersect ((p point) (s hsegment)) (hs-p-intersect s p))

(defun vs-p-intersect (vs p)
  (and (= (x p) (x (from vs)))
       (<= (min (y (from vs))
                (y (to vs)))
           (y p)
           (max (y (from vs))
                (y (to vs))))
       (vsegment (from vs) (point (x p) (y p)))))

(defmethod intersect ((s vsegment) (p point)) (vs-p-intersect s p))
(defmethod intersect ((p point) (s vsegment)) (vs-p-intersect s p))

(first
 (sort (delete nil
               (map-product (lambda (s1 s2)
                              (if-let (i (intersect s1 s2))
                                (+ (gethash s1 (first *steps*))
                                   (steps (intersect s1 i))
                                   (gethash s2 (second *steps*))
                                   (steps (intersect s2 i)))))
                            (elt *input* 0)
                            (elt *input* 1)))
       #'<))