day-4.lisp (1647B)
1 (defpackage #:aoc/day-4 2 (:use #:cl #:aoc/utils) 3 (:export #:day-4)) 4 (in-package #:aoc/day-4) 5 6 (defun count-xmas (map point) 7 (loop for (nx . ny) in *map-neighbours* 8 sum (loop for (m char) in '((1 #\M) (2 #\A) (3 #\S)) 9 for new-point = (point+ point (cons (* nx m) 10 (* ny m))) 11 for cell = nil 12 unless (point-in-map-p new-point map) 13 do (return 0) 14 do (setf cell (map-cell map new-point)) 15 unless (char= cell char) 16 do (return 0) 17 finally (return 1)))) 18 19 (defun mas-p (map point t-x) 20 (let ((ps (list (point+ point (cons t-x -1)) 21 (point+ point (cons (* t-x -1) 1))))) 22 (unless (every (rcurry #'point-in-map-p map) ps) 23 (return-from mas-p nil)) 24 (let ((cs (mapcar (curry #'map-cell map) ps))) 25 (and (member #\M cs) 26 (member #\S cs))))) 27 28 (defun x-mas-p (map point) 29 (and (mas-p map point -1) 30 (mas-p map point 1))) 31 32 (defun day-4 (input) 33 (loop with map = (make-map input) 34 with task-1 = 0 35 with task-2 = 0 36 for x from 0 below (input-map-width map) 37 do (loop for y from 0 below (input-map-height map) 38 for point = (cons x y) 39 for elem = (map-cell map point) 40 when (char= elem #\X) 41 do (incf task-1 (count-xmas map point)) 42 when (and (char= elem #\A) 43 (x-mas-p map point)) 44 do (incf task-2)) 45 finally (return (values task-1 task-2))))