this post was submitted on 08 Dec 2025
21 points (100.0% liked)

Advent Of Code

1199 readers
13 users here now

An unofficial home for the advent of code community on programming.dev! Other challenges are also welcome!

Advent of Code is an annual Advent calendar of small programming puzzles for a variety of skill sets and skill levels that can be solved in any programming language you like.

Everybody Codes is another collection of programming puzzles with seasonal events.

EC 2025

AoC 2025

Solution Threads

M T W T F S S
1 2 3 4 5 6 7
8 9 10 11 12

Visualisations Megathread

Rules/Guidelines

Relevant Communities

Relevant Links

Credits

Icon base by Lorc under CC BY 3.0 with modifications to add a gradient

console.log('Hello World')

founded 2 years ago
MODERATORS
 

Day 8: Playground

Megathread guidelines

  • Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
  • You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL

FAQ

you are viewing a single comment's thread
view the rest of the comments
[–] ystael@beehaw.org 3 points 2 weeks ago

Another factor of 10 in problem size would have required more efficient data structures and the "correct" algorithm. But as it is, we can get by with sets-as-lists and just updating a hash table, if we're willing to wait a few seconds for the answer.

(ql:quickload :str)

(defun parse-line (line)
  (coerce (mapcar #'parse-integer (str:split "," line)) 'vector))

(defun read-inputs (filename)
  (let ((input-lines (uiop:read-file-lines filename)))
    (make-array (list (length input-lines) 3)
                :initial-contents (mapcar #'parse-line input-lines))))

(defun distance (points p q)
  (flet ((square (x) (* x x)))
    (sqrt (+ (square (- (aref points p 0) (aref points q 0)))
             (square (- (aref points p 1) (aref points q 1)))
             (square (- (aref points p 2) (aref points q 2)))))))

(defun all-labeled-edges (points)
  (loop for j from 0 to (1- (car (array-dimensions points)))
        nconcing (loop for i from 0 to (1- j)
                       collect (list (distance points i j) i j))))

(defun short-labeled-edges (points nedges)
  (subseq (sort (all-labeled-edges points) #'< :key #'first) 0 nedges))

(defun adjacency-map (labeled-edges)
  (let ((result (make-hash-table)))
    (loop for (nil v w) in labeled-edges
          do (setf (gethash v result) (cons w (gethash v result)))
             (setf (gethash w result) (cons v (gethash w result))))
    result))

(defun components (n adjacency-map)
  (let ((remaining (loop for i from 0 to (1- n) collect i))
        (result nil))
    (loop for v = (car remaining)
          until (null v)
          do (let ((this-component nil)
                   (next-component (list v)))
               (loop until (subsetp next-component this-component)
                     do (progn
                          (setf this-component next-component)
                          (setf next-component
                                (reduce #'union
                                        (cons this-component
                                              (mapcar #'(lambda (w) (gethash w adjacency-map))
                                                      this-component))))))
               (setf result (cons this-component result))
               (loop for w in this-component
                     do (setf remaining (delete w remaining)))))
    result))

(defun main-1 (filename)
  (let* ((points (read-inputs filename))
         (adjacency (adjacency-map (short-labeled-edges points 1000)))
         (components (components (car (array-dimensions points)) adjacency))
         (lengths (sort (mapcar #'length components) #'>)))
    (* (car lengths) (cadr lengths) (caddr lengths))))

(defun fusing-edge (n labeled-edges)
  (let ((sorted-edges (sort labeled-edges #'< :key #'first))
        (components (make-hash-table)))
    (loop for i from 0 to (1- n)
          do (setf (gethash i components) (list i)))
    (loop for (nil v w) in sorted-edges
          do (let ((new-component (union (gethash v components) (gethash w components))))
               (cond ((= (length new-component) n)
                      (return (list v w)))
                     ((not (subsetp new-component (gethash v components)))
                      (loop for x in new-component
                            do (setf (gethash x components) new-component))))))))

(defun main-2 (filename)
  (let* ((points (read-inputs filename))
         (n (car (array-dimensions points))))
    (destructuring-bind (v w) (fusing-edge n (all-labeled-edges points))
      (* (aref points v 0) (aref points w 0)))))