Skip to content

Instantly share code, notes, and snippets.

@death
Last active December 19, 2021 16:40
Show Gist options
  • Save death/73643d1563095aec0042d92933d441b8 to your computer and use it in GitHub Desktop.
Save death/73643d1563095aec0042d92933d441b8 to your computer and use it in GitHub Desktop.
aoc2021 day19
;;;; +----------------------------------------------------------------+
;;;; | Advent of Code 2021 |
;;;; +----------------------------------------------------------------+
(defpackage #:snippets/aoc2021/day19
(:use #:cl)
(:export
#:day19))
(in-package #:snippets/aoc2021/day19)
(defstruct scanner
number
beacons)
(defun beacon- (beacon1 beacon2)
(mapcar #'- beacon1 beacon2))
(defun beacon+ (beacon1 beacon2)
(mapcar #'+ beacon1 beacon2))
(defun parse (input)
(let ((scanner (make-scanner))
(scanners '()))
(labels ((finish-scanner ()
(when (scanner-number scanner)
(setf (scanner-beacons scanner)
(nreverse (scanner-beacons scanner)))
(push scanner scanners)
(setf scanner (make-scanner)))))
(dolist (numbers input)
(ecase (length numbers)
(0)
(1
(finish-scanner)
(setf (scanner-number scanner) (first numbers)))
(3
(push numbers (scanner-beacons scanner)))))
(finish-scanner)
(nreverse scanners))))
(defun beacon-norm (beacon)
(reduce #'+ beacon :key #'abs))
(defun beacon-norms (scanner reference)
(mapcar (lambda (beacon)
(beacon-norm (beacon- beacon reference)))
(scanner-beacons scanner)))
(defun find-candidates (scanners)
(let ((candidates '()))
(loop for (s1 . s1-rest) on scanners
do (dolist (s2 s1-rest)
(block found-consistent
(dolist (b1 (scanner-beacons s1))
(let ((n1 (beacon-norms s1 b1)))
(dolist (b2 (scanner-beacons s2))
(let ((n2 (beacon-norms s2 b2)))
(let ((m (length (intersection n1 n2))))
(when (>= m 12)
(push (list s1 b1 s2 b2) candidates)
(return-from found-consistent))))))))))
(nreverse candidates)))
(defun make-configuration (m o)
(lambda (beacon)
(let ((b1 (mapcar #'* beacon m)))
(mapcar (lambda (i) (nth i b1)) o))))
(defun make-configurations ()
(let ((configurations '()))
(dolist (sx '(-1 +1))
(dolist (sy '(-1 +1))
(dolist (sz '(-1 +1))
(dolist (order '((0 1 2) (0 2 1) (1 0 2)
(1 2 0) (2 1 0) (2 0 1)))
(push (make-configuration (list sx sy sz) order)
configurations)))))
configurations))
(defvar *configurations*
(make-configurations))
(defun apply-configuration (configuration beacon)
(funcall configuration beacon))
(defun find-relative-position (s1 b1 c1 s2 b2)
(let ((o1 (mapcar (lambda (b) (apply-configuration c1 (beacon- b b1)))
(scanner-beacons s1))))
(loop for configuration in *configurations*
for b2-ref = (apply-configuration configuration b2)
for o2 = (mapcar (lambda (b) (beacon- (apply-configuration configuration b) b2-ref))
(scanner-beacons s2))
when (>= (length (intersection o1 o2 :test #'equal)) 12)
do (return-from find-relative-position
(values (beacon- (apply-configuration c1 b1) b2-ref) configuration)))))
(defun find-relative-positions (scanners)
(let* ((candidates (find-candidates scanners))
(positions-relative-to-s0 (make-array (length scanners) :initial-element nil))
(configurations (make-array (length scanners) :initial-element nil)))
(setf (aref positions-relative-to-s0 0) '(0 0 0))
(setf (aref configurations 0) (make-configuration '(+1 +1 +1) '(0 1 2)))
(loop until (null candidates)
do (destructuring-bind (s1 b1 s2 b2) (pop candidates)
(when (null (aref positions-relative-to-s0 (scanner-number s1)))
(rotatef s1 s2)
(rotatef b1 b2))
(if (null (aref positions-relative-to-s0 (scanner-number s1)))
(setf candidates (append candidates (list (list s1 b1 s2 b2))))
(when (null (aref positions-relative-to-s0 (scanner-number s2)))
(let ((c1 (aref configurations (scanner-number s1))))
(multiple-value-bind (position-relative-to-s1 configuration)
(find-relative-position s1 b1 c1 s2 b2)
(setf (aref positions-relative-to-s0 (scanner-number s2))
(beacon+ position-relative-to-s1
(aref positions-relative-to-s0 (scanner-number s1))))
(setf (aref configurations (scanner-number s2))
configuration)
(let ((candidates-containing-s2
(loop for candidate in candidates
when (member s2 candidate)
collect candidate)))
(setf candidates
(append candidates-containing-s2
(set-difference candidates candidates-containing-s2))))))))))
(values positions-relative-to-s0 configurations)))
(defun count-beacons (scanners positions configurations)
(let ((beacons (make-hash-table :test 'equal)))
(loop for scanner in scanners
for position across positions
for configuration across configurations
do (dolist (beacon (scanner-beacons scanner))
(let ((beacon (apply-configuration configuration beacon)))
(setf (gethash (beacon+ beacon position) beacons) t))))
(hash-table-count beacons)))
(defun largest-distance (positions)
(do ((d 0)
(i 0 (1+ i)))
((= i (length positions)) d)
(do ((j (1+ i) (1+ j)))
((= j (length positions)))
(setf d (max d (beacon-norm (beacon- (aref positions i) (aref positions j))))))))
(defun day19 (input)
(let ((scanners (parse input)))
(multiple-value-bind (positions configurations)
(find-relative-positions scanners)
(list (count-beacons scanners positions configurations)
(largest-distance positions)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment