day-13.lisp (3067B)
1 (defpackage #:aoc/day-13 2 (:use #:cl #:aoc/utils) 3 (:export #:day-13)) 4 (in-package #:aoc/day-13) 5 6 (defun reflection-finding-properties (map type) 7 (ecase type 8 (:vertical 9 (values (input-map-width map) 10 (input-map-height map) 11 (lambda (primary secondary) 12 (cons primary secondary)))) 13 (:horizontal 14 (values (input-map-height map) 15 (input-map-width map) 16 (lambda (primary secondary) 17 (cons secondary primary)))))) 18 19 (defun find-reflection-imperfections (map reflection-point primary-axis-length secondary-axis-length make-point) 20 (loop with reflection-length = (min (1+ reflection-point) 21 (- primary-axis-length reflection-point 1)) 22 with imperfections = 0 23 repeat reflection-length 24 for compare-1 downfrom reflection-point 25 for compare-2 from (1+ reflection-point) 26 while (<= imperfections 1) 27 do (loop for secondary-axis-point from 0 below secondary-axis-length 28 for point-1 = (funcall make-point compare-1 secondary-axis-point) 29 for point-2 = (funcall make-point compare-2 secondary-axis-point) 30 when (char/= (map-cell map point-1) 31 (map-cell map point-2)) 32 do (incf imperfections) 33 while (<= imperfections 1)) 34 finally (return imperfections))) 35 36 (defun find-point-of-reflection (map type) 37 (multiple-value-bind (primary-axis-length secondary-axis-length make-point) 38 (reflection-finding-properties map type) 39 (loop with perfect-point-of-reflection = nil 40 with imperfect-point-of-reflection = nil 41 for reflection-point from 0 below (1- primary-axis-length) 42 for reflection-imperfections = (find-reflection-imperfections map reflection-point 43 primary-axis-length secondary-axis-length 44 make-point) 45 when (= reflection-imperfections 0) 46 do (setf perfect-point-of-reflection (1+ reflection-point)) 47 when (= reflection-imperfections 1) 48 do (setf imperfect-point-of-reflection (1+ reflection-point)) 49 until (and perfect-point-of-reflection imperfect-point-of-reflection) 50 finally (return (list perfect-point-of-reflection imperfect-point-of-reflection))))) 51 52 (defun day-13 (input) 53 (loop for map = (make-map input) 54 while map 55 for (perfect-vertical-reflection imperfect-vertical-reflection) = (find-point-of-reflection map :vertical) 56 for (perfect-horizontal-reflection imperfect-horizontal-reflection) = (find-point-of-reflection map :horizontal) 57 sum (or perfect-vertical-reflection 58 (* perfect-horizontal-reflection 100)) into task-1 59 sum (or imperfect-vertical-reflection 60 (* imperfect-horizontal-reflection 100)) into task-2 61 finally (return (values task-1 task-2))))