day23.lisp (4252B)
1 (defpackage #:adventofcode2022/day23 2 (:use #:cl #:adventofcode2022) 3 (:import-from #:alexandria 4 #:rotate 5 #:hash-table-keys)) 6 (in-package #:adventofcode2022/day23) 7 8 (defparameter *directions-order* (list '((0 -1) (-1 -1) (1 -1)) 9 '((0 1) (-1 1) (1 1)) 10 '((-1 0) (-1 -1) (-1 1)) 11 '((1 0) (1 -1) (1 1)))) 12 13 (defun make-map (inputs) 14 (loop with map = (make-hash-table :test 'equal) 15 for input in inputs 16 for y from 0 17 do (loop for char across input 18 for x from 0 19 when (char= char #\#) 20 do (setf (gethash (list x y) map) t)) 21 finally (return map))) 22 23 (defun calculate-score (map) 24 (loop with (min-y max-y min-x max-x) = (loop for elf being the hash-key of map 25 minimize (car elf) into min-x 26 minimize (cadr elf) into min-y 27 maximize (car elf) into max-x 28 maximize (cadr elf) into max-y 29 finally (return (list min-y max-y min-x max-x))) 30 for y from min-y to max-y 31 sum (loop for x from min-x to max-x 32 unless (gethash (list x y) map) 33 sum 1))) 34 35 (defun print-map (map) 36 (loop with (max-y max-x) = (loop for elf being the hash-key of map 37 maximize (car elf) into max-x 38 maximize (cadr elf) into max-y 39 finally (return (list max-y max-x))) 40 for y to max-y 41 do (loop for x to max-x 42 do (format t "~A" 43 (if (gethash (list x y) map) #\# #\.))) 44 do (format t "~%")) 45 (format t "~%")) 46 47 (defun coord+ (a b) 48 (list (+ (car a) (car b)) 49 (+ (cadr a) (cadr b)))) 50 51 (defun elf-can-move-p (map elf direction) 52 (loop for delta in direction 53 always (not (gethash (coord+ elf delta) map)))) 54 55 (defun elf-has-neighbor (map elf) 56 (loop for delta-set in *directions-order* 57 thereis (loop for delta in delta-set 58 for neighbor = (coord+ elf delta) 59 thereis (gethash neighbor map)))) 60 61 (defun remove-impossible-steps (steps) 62 (remove-if (lambda (step) 63 (> (count-if (lambda (other-step) 64 (equal (cadr step) (cadr other-step))) 65 steps) 66 1)) 67 steps)) 68 69 (defun move-elves (map &optional max-rounds) 70 (loop with current-order = (copy-seq *directions-order*) 71 for round from 1 72 while (or (null max-rounds) 73 (<= round max-rounds)) 74 for proposed-steps = (loop for elf in (remove-if (lambda (elf) 75 (not (elf-has-neighbor map elf))) 76 (hash-table-keys map)) 77 for valid-direction = (loop for direction in current-order 78 when (elf-can-move-p map elf direction) 79 return (car direction) 80 finally (return nil)) 81 when valid-direction 82 collect (list elf (coord+ elf valid-direction))) 83 84 for valid-moves = (remove-impossible-steps proposed-steps) 85 while valid-moves 86 do (loop for (previous next) in valid-moves 87 do (remhash previous map) 88 do (setf (gethash next map) t)) 89 do (setf current-order (rotate current-order (1- (length current-order)))) 90 ;;do (print-map map) 91 finally (return (values (calculate-score map) round)))) 92 93 (defun task1 (inputs) 94 (nth-value 0 (move-elves (make-map inputs) 10))) 95 96 (defun task2 (inputs) 97 (nth-value 1 (move-elves (make-map inputs)))) 98 99 (define-day 23 100 () 101 #'task1 102 #'task2)