AoC 2021 Day 19

AoC 2021 Day 19

(struct scanner (id beacons fingerprint [rel/pos #:mutable]) #:transparent)
(struct beacon (id scanner rel/pos [abs/pos #:mutable]) #:transparent)

;; Any scanner can be the base, the problem uses scanner 0
(define *BASE* 0)

;; base scanner is S0.
;; Some scanners must overlap beacons with S0
;; Find their orientations/positions relative to S0
;; These form the queue of a BFS.
;;   - queue item is orientation & vector needed to transform into S0's frame of reference
;;   When scanner Sn is dequeued
;;     - find all other (unprocessed) scanners Sk, with overlapping beacons
;;       - find orientation & position of Sk relative to Sn
;;       - combine Sk and Sn orientation/vector for Sk relative to S0
;;     - add them to the queue.;;
;; part 1: iterate beacons for all scanners and count the unique positions (relative to S0)
;; part 2: iterate all scanner pairs and find the maximum manhattan distance

(define (part-02 input)
  (define S  (parse-scanners input))
  (define unseen (apply mutable-seteq (remove *BASE* (hash-keys S))))
  (define Q (make-queue))

  (define (orientations/bfs)
    (cond [(queue-empty? Q) (void)]
          [else (match-define (list a:id O:a->*BASE* V:a->*BASE*) (dequeue! Q))
                (define sa (hash-ref S a:id))
                (for* ([v (in-set unseen)]
                       [sb (in-value (hash-ref S v))]
                       [I (in-list (intersections sa sb))])
                  (define-values (O:b->a V:b->a) (local-transformation I))
                  (define V:b->*BASE* (global-transformation O:a->*BASE* O:b->a V:a->*BASE* V:b->a (set-first I)))
                  (define O:b->*BAE* (reduce-orientation O:b->a O:a->*BASE*))
                  (set-scanner-rel/pos! sb V:b->*BASE*)
                  (for ([b (in-list (scanner-beacons sb))])
                    (define b/*BASE* (vec V:b->*BASE* (orientation (beacon-rel/pos b) O:b->*BAE*)))
                    (set-beacon-abs/pos! b b/*BASE*))
                  (set-remove! unseen v)
                  (enqueue! Q (list v O:b->*BAE* V:b->*BASE*)))
                (orientations/bfs)]))

  (define O:origin 0)
  (define V:origin (list 0 0 0))
  (enqueue! Q (list *BASE* O:origin V:origin))
  (orientations/bfs)
  (cons (count-beacons (hash-values S))
        (max-separation S)))

(define (parse-scanners ss)
  (for/hash ([(s i) (in-indexed (in-list ss))])
    (define readings (map numbers (rest (lines s))))
    (define bs (parse-beacons i readings))
    (define ls (fingerprint-beacons bs))
    (values i (scanner i bs ls (and (= *BASE* i) (list 0 0 0))))))

(define (parse-beacons S rs)
  (for/list ([(r i) (in-indexed (in-list rs))])
    (beacon i S r (and (= *BASE* S) r))))

(define (fingerprint-beacons bs)
  (for/fold ([ls (hash)])
            ([bs (in-combinations bs 2)])
    (define a/pos (beacon-rel/pos (first bs)))
    (define b/pos (beacon-rel/pos (second bs)))
    (hash-set ls (distance^2 (vec a/pos b/pos)) bs)))

(define (global-transformation O:global O:local V:global V:local intersection)
  (define rel/pos (beacon-rel/pos (second (second intersection))))
  ;; how origin sees b
  (define b/origin (vec V:global (orientation (vec V:local (orientation rel/pos O:local)) O:global)))
  ;; vector from b's Scanner - > S0 is
  ;; b's position (as seen by S0) -> rel/pos oriented to S0
  (vec b/origin (combine-orientations rel/pos O:local O:global)))

(define (count-beacons S)
  (set-count
   (for*/set ([s (in-list S)]
              [b (in-list (scanner-beacons s))])
     (beacon-abs/pos b))))

;; the beacons that intersect in scanners a & b
(define (intersections a b)
  (define fingerprint/a (scanner-fingerprint a))
  (define fingerprint/b (scanner-fingerprint b))
  (define distances (set-intersect (hash-keys fingerprint/a) (hash-keys fingerprint/b)))
  (define beacons (beacons@ distances fingerprint/a fingerprint/b))
  (if (>= (set-count distances) 66)
      (list beacons)
      null))

;; For 2 scanners a, b - find the local orientation and translation
(define (local-transformation is)
  (for*/fold ([o/count (hash)]
              [V/ba (hash)]
              #:result (values (histogram/max o/count)
                               (histogram/max V/ba)))
             ([s (in-set is)]
              #:break (and (consensus? o/count) (consensus? V/ba)))
    (match-define (list (list av a1 a2) (list bv b1 b2)) s)
    (define o (relative-orientation av bv))
    (define t1 (and o (vec (beacon-rel/pos a1) (orientation (beacon-rel/pos b1) o))))
    (if o
        (values (hash-update o/count o add1 0)
                (hash-update V/ba t1 add1 0))
        (values o/count V/ba))))

;; some internal beacon pairs give false positive match
;; testing for intersections so use a majority consensus.
(define *consensus* 3)
(define (consensus? h)
  (for/or ([v (in-hash-values h)])
    (> v *consensus*)))

;; he set of internal matching beacon pairs
;; that match in 2 scanner a and b
(define (beacons@ distances la lb)
  (for/set ([d (in-list distances)])
    (define a/pair (hash-ref la d))
    (define b/pair (hash-ref lb d))
    (define va (apply vec (map beacon-rel/pos a/pair)))
    (define vb (apply vec (map beacon-rel/pos b/pair)))
    (list (cons va a/pair) (cons vb b/pair))))

(define (in-orientations p)
  (in-indexed (in-list (orientations/3d p))))

;; once the relative orientation is known and indexed, apply it directly
;; hard-coded transformations to avoid iterating/calculating all 24
(define (orientation p i)
  (match-define (list x y z) p)
  (match-define (list -x -y -z)(map - p))
  (match i
    [ 0 (list  x  y  z)]
    [ 1 (list  x -y -z)]
    [ 2 (list  x  z -y)]
    [ 3 (list  x -z  y)]
    [ 4 (list -x  y -z)]
    [ 5 (list -x -y  z)]
    [ 6 (list -x  z  y)]
    [ 7 (list -x -z -y)]
    [ 8 (list  y  x -z)]
    [ 9 (list  y -x  z)]
    [10 (list  y  z  x)]
    [11 (list  y -z -x)]
    [12 (list -y  x  z)]
    [13 (list -y -x -z)]
    [14 (list -y  z -x)]
    [15 (list -y -z  x)]
    [16 (list  z  x  y)]
    [17 (list  z -x -y)]
    [18 (list  z  y -x)]
    [19 (list  z -y  x)]
    [20 (list -z  x -y)]
    [21 (list -z -x  y)]
    [22 (list -z  y  x)]
    [23 (list -z -y -x)]))

(define (distance^2 p)
  (apply + (map sqr p)))

(define (orientations/3d p)
  (for/list ([i (in-range 24)])
    (orientation p i)))

(define (combine-orientations p o1 o2)
  (orientation p (reduce-orientation o1 o2)))

;; Combine local and global orientations.
;; remember the result since it's used often
(define reduce-orientation
  (let ([reduced (make-hash)]
        [p '(1 2 3)])
    (λ (o1 o2)
      (hash-ref!
       reduced (list o1 o2)
       (λ ()
         (define oriented (orientation (orientation p o1) o2))
         (for/or ([(o i) (in-orientations p)])
           (and (equal? o oriented) i)))))))

;; orientation of matching beacons pairs in 2 scanners.
(define (relative-orientation va vb)
 (for/first ([(o i) (in-orientations vb)]
             #:when (equal? o va))
   i))

;; the consensus of readings with false positive matches
(define (histogram/max h #:key [key values])
  (for/fold ([m 0] [r #f] #:result r)
            ([(k v) (in-hash h)] #:when (> (key v) m))
    (values v k)))

; vector from a to b
(define (vec a b)
  (map - b a))

;; manhattan distance between two points
(define (manhattan a b)
  (apply + (map abs (vec a b))))

(define (max-separation S)
  (for/fold ([max-separation 0] [ids #f] #:result (list max-separation ids))
            ([ij (in-combinations (hash-values S) 2)])
    (define separation (apply manhattan (map scanner-rel/pos ij)))
    (if (> separation max-separation)
        (values separation (map scanner-id ij))
        (values max-separation ids))))