day-10.lisp (4207B)
1 (defpackage #:aoc/day-10 2 (:use #:cl #:aoc/utils) 3 (:export #:day-10)) 4 (in-package #:aoc/day-10) 5 6 ;; screws up my syntax highlighting 7 (defconstant +char-pipe+ (code-char 124)) 8 9 (defun walk (dir pipe) 10 (switch (pipe) 11 (+char-pipe+ 12 (switch (dir :test 'equal) 13 ((cons 0 1) (cons 0 1)) 14 ((cons 0 -1) (cons 0 -1)))) 15 (#\- 16 (switch (dir :test 'equal) 17 ((cons 1 0) (cons 1 0)) 18 ((cons -1 0) (cons -1 0)))) 19 (#\L 20 (switch (dir :test 'equal) 21 ((cons 0 1) (cons 1 0)) 22 ((cons -1 0) (cons 0 -1)))) 23 (#\J 24 (switch (dir :test 'equal) 25 ((cons 0 1) (cons -1 0)) 26 ((cons 1 0) (cons 0 -1)))) 27 (#\7 28 (switch (dir :test 'equal) 29 ((cons 1 0) (cons 0 1)) 30 ((cons 0 -1) (cons -1 0)))) 31 (#\F 32 (switch (dir :test 'equal) 33 ((cons -1 0) (cons 0 1)) 34 ((cons 0 -1) (cons 1 0)))))) 35 36 (defparameter *neighbouring-pipes-dirs* '((1 . 0) 37 (0 . 1) 38 (-1 . 0) 39 (0 . -1))) 40 41 (defun find-start-pos (map) 42 (loop for y from 0 below (input-map-height map) 43 thereis (loop for x from 0 below (input-map-width map) 44 for point = (cons x y) 45 for pipe = (map-cell map point) 46 when (char= pipe #\S) 47 do (return point)))) 48 49 (defun find-first-step (map start-pos) 50 (loop for dir in *neighbouring-pipes-dirs* 51 for new-point = (point+ start-pos dir) 52 for new-dir = (walk dir (map-cell map new-point)) 53 when new-dir 54 do (return (values dir new-point)))) 55 56 (defun find-position-pipe-type (pos started-at finished-at) 57 (let ((diff-s (point- started-at pos)) 58 (diff-e (point- finished-at pos))) 59 (or (switch (diff-s :test #'equal) 60 ((cons 1 0) 61 (switch (diff-e :test #'equal) 62 ((cons 0 1) #\F) 63 ((cons -1 0) #\-) 64 ((cons 0 -1) #\L))) 65 ((cons 0 1) 66 (switch (diff-e :test #'equal) 67 ((cons -1 0) #\7) 68 ((cons 0 -1) +char-pipe+))) 69 ((cons -1 0) 70 (when (equal diff-e (cons 0 -1)) #\J))) 71 (error "Invalid start and end nodes ~A / ~A" diff-s diff-e)))) 72 73 (defun task-1 (map dir pos) 74 (loop with loop = (make-hash-table :test 'equal) 75 with coming-from = nil 76 for steps from 1 77 for pipe = (map-cell map pos) 78 do (setf (gethash pos loop) pipe) 79 when (char= pipe #\S) 80 do (return (values (/ steps 2) 81 loop 82 coming-from)) 83 do (setf dir (walk dir pipe)) 84 do (assert dir) 85 do (setf coming-from pos 86 pos (point+ pos dir)))) 87 88 (defun crossing-pipe-p (pipe) 89 (cond 90 ((char= pipe +char-pipe+) t) 91 ((char= pipe #\L) #\7) 92 ((char= pipe #\F) #\J))) 93 94 (defun task-2 (map loop) 95 (loop for y from 0 below (input-map-height map) 96 for in-loop? = nil 97 for crossing-when = nil 98 sum (loop for x from 0 below (input-map-width map) 99 for point = (cons x y) 100 for pipe = (map-cell map point) 101 for loop-pipe = (gethash point loop) 102 for crossing-pipe? = (and loop-pipe 103 (or (eql loop-pipe crossing-when) 104 (crossing-pipe-p loop-pipe))) 105 when (characterp crossing-pipe?) 106 do (setf crossing-when crossing-pipe? 107 crossing-pipe? nil) 108 when crossing-pipe? 109 do (setf in-loop? (not in-loop?)) 110 when (and in-loop? (not loop-pipe)) 111 sum 1))) 112 113 (defun day-10 (input) 114 (let* ((map (make-map input)) 115 (start-pos (find-start-pos map))) 116 (multiple-value-bind (dir pos) 117 (find-first-step map start-pos) 118 (multiple-value-bind (task-1 loop coming-from) 119 (task-1 map dir pos) 120 (setf (gethash start-pos loop) 121 (find-position-pipe-type start-pos pos coming-from)) 122 (values task-1 (task-2 map loop))))))