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)))))