Last active
December 4, 2019 17:44
-
-
Save christophejunke/67f0cac578ecc2333175f05cb89246da to your computer and use it in GitHub Desktop.
day-03-alt.lisp
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defpackage :advent.2019.03-alt (:use :cl :alexandria :cl-ppcre)) | |
(in-package :advent.2019.03-alt) | |
(defstruct seg lo hi o d z) | |
(defstruct (hseg (:constructor hseg (lo hi o d z)) (:include seg))) | |
(defstruct (vseg (:constructor vseg (lo hi o d z)) (:include seg))) | |
(defun seg (type from to z) | |
(funcall type | |
(min from to) | |
(max from to) | |
from | |
to | |
z)) | |
(defmacro x (o) `(realpart ,o)) | |
(defmacro y (o) `(imagpart ,o)) | |
(defmacro pt (x y) `(complex ,x ,y)) | |
(defgeneric from (segment) | |
(:method ((s hseg)) (pt (seg-o s) (seg-z s))) | |
(:method ((s vseg)) (pt (seg-z s) (seg-o s)))) | |
(defgeneric to (segment) | |
(:method ((s hseg)) (pt (seg-d s) (seg-z s))) | |
(:method ((s vseg)) (pt (seg-z s) (seg-d s)))) | |
(defun segment (origin direction length) | |
(with-accessors ((ox realpart) (oy imagpart)) origin | |
(flet ((make (type sign &aux (d (* sign length))) | |
(ecase type | |
(hseg (seg 'hseg ox (+ ox d) oy)) | |
(vseg (seg 'vseg oy (+ oy d) ox))))) | |
(ecase direction | |
(#\U (make 'vseg -1)) | |
(#\D (make 'vseg +1)) | |
(#\L (make 'hseg -1)) | |
(#\R (make 'hseg +1)))))) | |
(defun manhattan (p1 p2) | |
(+ (abs (- (x p2) (x p1))) | |
(abs (- (y p2) (y p1))))) | |
(defun parse-wires (file) | |
(flet ((parse-segment (origin string) | |
(segment origin | |
(char string 0) | |
(parse-integer string :start 1)))) | |
(with-open-file (in file) | |
(loop | |
for line = (read-line in nil nil) | |
while line | |
collect (let ((origin )) | |
(flet ((parse (s) | |
(let ((segment (parse-segment origin s))) | |
(prog1 segment | |
(setf origin (to segment)))))) | |
(mapcar #'parse (split #\, line :sharedp t)))))))) | |
(defvar *input* (parse-wires "~/tmp/advent/03.in")) | |
(defun intersect/orthogonal (h v) | |
(let ((ix (seg-z v)) | |
(iy (seg-z h))) | |
(and (<= (seg-lo h) ix (seg-hi h)) | |
(<= (seg-lo v) iy (seg-hi v)) | |
(pt ix iy)))) | |
(defun intersect/parallel (type s1 s2) | |
(and (= (seg-z s1) (seg-z s2)) | |
(let ((lo (max (seg-lo s1) (seg-hi s2))) | |
(hi (min (seg-hi s1) (seg-hi s2)))) | |
(cond | |
((= lo hi) | |
(case type | |
(hseg (pt lo (seg-z s1))) | |
(vseg (pt (seg-z s1) lo)))) | |
((< lo hi) | |
(seg type lo hi (seg-z s1))))))) | |
(defgeneric intersect (s1 s2) | |
(:method ((h hseg) (v vseg)) (intersect/orthogonal h v)) | |
(:method ((v vseg) (h hseg)) (intersect/orthogonal h v)) | |
(:method ((s1 hseg) (s2 hseg)) (intersect/parallel 'hseg s1 s2)) | |
(:method ((s1 vseg) (s2 vseg)) (intersect/parallel 'vseg s1 s2))) | |
;; day 3 - part 1 | |
(defvar *intersections* | |
(delete nil (map-product #'intersect | |
(elt *input* 0) | |
(elt *input* 1)))) | |
(loop | |
for p in *intersections* | |
unless (zerop p) | |
minimize (manhattan 0 p)) | |
;; day 3 - part 2 | |
(defun segment-steps (s) | |
(- (seg-hi s) (seg-lo 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 (segment-steps s)) | |
finally (return hash))) | |
(defvar *steps* (map 'list #'count-steps *input*)) | |
(flet ((cut% (tt s p z) (seg tt (seg-o s) p z))) | |
(declare (inline cut%)) | |
(defgeneric cut (seg point) | |
(:method ((s hseg) (p complex)) (cut% 'hseg s (x p) (y p))) | |
(:method ((s vseg) (p complex)) (cut% 'vseg s (y p) (x p))))) | |
(loop | |
with wire-1-steps = (first *steps*) | |
with wire-2-steps = (second *steps*) | |
for v in (delete nil | |
(map-product (lambda (s1 s2) | |
(if-let (i (intersect s1 s2)) | |
(unless (eql 0 i) | |
(+ (gethash s1 wire-1-steps) | |
(segment-steps (cut s1 i)) | |
(gethash s2 wire-2-steps) | |
(segment-steps (cut s2 i)))))) | |
(elt *input* 0) | |
(elt *input* 1))) | |
unless (zerop v) | |
minimize v) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Modified version with a better data structure for segments that reduces corner cases on intersection tests