day-3.lisp (3692B)
1 (defpackage #:aoc/day-3 2 (:use #:cl #:aoc/utils) 3 (:export #:day-3)) 4 (in-package #:aoc/day-3) 5 6 (defun schematic-symbol-p (symbol) 7 (and (char/= symbol #\.) 8 (not (digit-char-p symbol)))) 9 10 (declaim (inline digit-at-p)) 11 (defun digit-at-p (map point) 12 (digit-char-p (map-cell map point))) 13 14 (defun number-borders-symbol (map y x-1 x-2 top-open? bottom-open? left-open? width) 15 (labels ((scan-line (y) 16 (loop for x from x-1 to x-2 17 for cell = (map-cell map (cons x y)) 18 thereis (schematic-symbol-p cell)))) 19 (or (when left-open? 20 (decf x-1) 21 (schematic-symbol-p (map-cell map (cons x-1 y)))) 22 (when (< x-2 (1- width)) 23 (incf x-2) 24 (schematic-symbol-p (map-cell map (cons x-2 y)))) 25 (and top-open? 26 (scan-line (1- y))) 27 (and bottom-open? 28 (scan-line (1+ y)))))) 29 30 (declaim (ftype (function (input-map cons) fixnum) read-part-number)) 31 (defun read-part-number (map point) 32 (destructuring-bind (x . y) 33 point 34 (map-integer-at map (cons (loop for sx from x downto 0 35 while (digit-at-p map (cons sx y)) 36 finally (return (1+ sx))) 37 y)))) 38 39 (defun get-gear-ratio (map point top-open? bottom-open? left-open? right-open?) 40 (macrolet ((push-neighbor-if-digit (check neighbour) 41 `(let ((p (point+ point ,neighbour))) 42 (when (and ,check 43 (digit-at-p map p)) 44 (push p number-points))))) 45 (let ((number-points)) 46 (push-neighbor-if-digit left-open? '(-1 . 0)) 47 (push-neighbor-if-digit right-open? '(1 . 0)) 48 (when top-open? 49 (unless (push-neighbor-if-digit t '(0 . -1)) 50 (push-neighbor-if-digit left-open? '(-1 . -1)) 51 (push-neighbor-if-digit right-open? '(1 . -1)))) 52 (when bottom-open? 53 (unless (push-neighbor-if-digit t '(0 . 1)) 54 (push-neighbor-if-digit left-open? '(-1 . 1)) 55 (push-neighbor-if-digit right-open? '(1 . 1)))) 56 (when (/= (length number-points) 2) 57 (return-from get-gear-ratio 0)) 58 (* (read-part-number map (first number-points)) 59 (read-part-number map (second number-points)))))) 60 61 (defun day-3 (input) 62 (loop with map = (make-map input) 63 with task-1 fixnum = 0 64 with task-2 fixnum = 0 65 with width = (input-map-width map) 66 with height = (input-map-height map) 67 for y from 0 below height 68 for top-open? = (> y 0) 69 for bottom-open? = (< y (1- height)) 70 do (loop for x from 0 below (input-map-width map) 71 for left-open? = (> x 0) 72 for right-open? = (< x (1- width)) 73 for point = (cons x y) 74 for cell = (map-cell map point) 75 do (cond 76 ((digit-char-p cell) 77 (multiple-value-bind (number end) 78 (map-integer-at map point) 79 (decf end) 80 (when (number-borders-symbol map y x end 81 top-open? bottom-open? 82 left-open? width) 83 (incf task-1 number)) 84 (setf x end))) 85 ((char= cell #\*) 86 (incf task-2 (get-gear-ratio map point 87 top-open? bottom-open? 88 left-open? right-open?))))) 89 finally (return (values task-1 task-2))))