day-11.lisp (1864B)
1 (defpackage #:aoc/day-11 2 (:use #:cl #:aoc/utils) 3 (:export #:day-11)) 4 (in-package #:aoc/day-11) 5 6 (defun find-galaxies (map) 7 (let (galaxies 8 empty-rows 9 empty-cols) 10 (loop for x from 0 below (input-map-width map) 11 for contains-galaxy? = nil 12 do (loop for y from 0 below (input-map-height map) 13 when (char= (map-cell map (cons x y)) #\#) 14 do (setf contains-galaxy? t) 15 and do (push (cons x y) galaxies)) 16 unless contains-galaxy? 17 do (push x empty-cols)) 18 (loop for y from 0 below (input-map-height map) 19 unless (loop for x from 0 below (input-map-width map) 20 thereis (char= (map-cell map (cons x y)) #\#)) 21 do (push y empty-rows)) 22 (values galaxies empty-rows empty-cols))) 23 24 (defun expand-universe (galaxies empty-rows empty-cols expansion-factor) 25 (decf expansion-factor) 26 (loop for galaxy in galaxies 27 collect (cons (+ (point-x galaxy) 28 (* (count-if (curry #'> (point-x galaxy)) empty-cols) 29 expansion-factor)) 30 (+ (point-y galaxy) 31 (* (count-if (curry #'> (point-y galaxy)) empty-rows) 32 expansion-factor))))) 33 34 (defun sum-distances (galaxies) 35 (loop for (galaxy-1 . rest) on galaxies 36 while rest 37 sum (loop for galaxy-2 in rest 38 sum (manhattan-distance galaxy-1 galaxy-2)))) 39 40 (defun day-11 (input) 41 (multiple-value-bind (galaxies empty-rows empty-cols) 42 (find-galaxies (make-map input)) 43 (let ((galaxies-1 (expand-universe galaxies empty-rows empty-cols 2)) 44 (galaxies-2 (expand-universe galaxies empty-rows empty-cols 1000000))) 45 (values (sum-distances galaxies-1) 46 (sum-distances galaxies-2)))))