I’m sure there are 17 different graph libraries I could have used for the graph representation and connected components, but it seemed to be in the spirit of the question to write it myself. Nothing interesting about the parent search though – it’s just brute-force comparison.

(ql:quickload :str)

(defun parse-line (line)
  (let ((index-and-codes (str:split ":" line)))
    (cons (parse-integer (car index-and-codes)) (cadr index-and-codes))))

(defun read-inputs (filename)
  (let ((input-lines (uiop:read-file-lines filename)))
    (mapcar #'parse-line input-lines)))

(defun can-be-child-of? (parent1 parent2 child)
  (loop for i from 0 to (1- (length child))
        unless (or (eql (char child i) (char parent1 i))
                   (eql (char child i) (char parent2 i)))
          return nil
        finally (return t)))

(defun similarity (genome1 genome2)
  (loop for i from 0 to (1- (length genome1))
        sum (if (eql (char genome1 i) (char genome2 i)) 1 0)))

(defun main-1 (filename)
  (let ((genomes (read-inputs filename)))
    (loop for arrangement in '((1 2 3) (2 3 1) (3 1 2))
          maximize
          (destructuring-bind (parent1-index parent2-index child-index) arrangement
            (let ((parent1 (cdr (assoc parent1-index genomes)))
                  (parent2 (cdr (assoc parent2-index genomes)))
                  (child (cdr (assoc child-index genomes))))
              (if (can-be-child-of? parent1 parent2 child)
                  (* (similarity parent1 child) (similarity parent2 child))
                  0))))))

(defun find-parents (genomes child-pair)
  (loop named loop1
        for tail1 on genomes
        for parent1-pair = (car tail1)
        do (loop for parent2-pair in (cdr tail1)
                 when (and
                       (/= (car parent1-pair) (car child-pair))
                       (/= (car parent2-pair) (car child-pair))
                       (can-be-child-of? (cdr parent1-pair) (cdr parent2-pair) (cdr child-pair)))
                   do (return-from loop1 (cons (car parent1-pair) (car parent2-pair))))
        finally (return-from loop1 nil)))

(defun child-relationships (genomes)
  (mapcar #'(lambda (child-pair)
              (cons (car child-pair) (find-parents genomes child-pair)))
          genomes))

(defun main-2 (filename)
  (let* ((genomes (read-inputs filename))
         (child-relationships (child-relationships genomes)))
    (loop for child-rel in child-relationships
          sum (destructuring-bind (child-idx . parent-idxs) child-rel
                (if (null parent-idxs)
                    0
                    (let ((parent1 (cdr (assoc (car parent-idxs) genomes)))
                          (parent2 (cdr (assoc (cdr parent-idxs) genomes)))
                          (child (cdr (assoc child-idx genomes))))
                      (* (similarity parent1 child) (similarity parent2 child))))))))

(defun relationship-graph (child-relationships)
  (let ((edges (mapcan #'(lambda (child-rel)
                           (destructuring-bind (child-idx . parent-idxs) child-rel
                             (if (null parent-idxs)
                                 nil
                                 (list (cons child-idx (car parent-idxs))
                                       (cons child-idx (cdr parent-idxs))))))
                       child-relationships))
        (graph (make-hash-table)))
    (loop for edge in edges
          do (destructuring-bind (x . y) edge
               (setf (gethash x graph) (cons y (gethash x graph)))
               (setf (gethash y graph) (cons x (gethash y graph)))))
    graph))

(defun component-of (graph vertex)
  (labels ((iter (so-far)
             (let ((next (reduce #'union
                                 (mapcar #'(lambda (v) (gethash v graph)) so-far)
                                 :initial-value so-far)))
               (if (subsetp next so-far)
                   next
                   (iter next)))))
    (iter (list vertex))))

(defun all-components (graph vertices)
  (labels ((iter (so-far vertices-left)
             (if (null vertices-left)
                 so-far
                 (let ((comp (component-of graph (car vertices-left))))
                   (iter (cons comp so-far)
                         (set-difference vertices-left comp))))))
    (iter nil vertices)))

(defun main-3 (filename)
  (let* ((genomes (read-inputs filename))
         (child-relationships (child-relationships genomes))
         (relationship-graph (relationship-graph child-relationships))
         (keys (mapcar #'car child-relationships))
         (components (all-components relationship-graph keys)))
    (reduce #'+
            (car (sort components #'(lambda (c1 c2) (> (length c1) (length c2))))))))

Haskell

Not particularly optimized but good enough.

import Control.Arrow ((***))  
import Data.Array (assocs)  
import Data.Function (on)  
import Data.Graph  
import Data.List  
import Data.Map (Map)  
import Data.Map qualified as Map  
import Data.Maybe  

readInput :: String -> Map Int [Char]  
readInput = Map.fromList . map ((read *** tail) . break (== ':')) . lines  

findRelations :: Map Int [Char] -> Graph  
findRelations dna =  
  buildG (1, Map.size dna)  
    . concatMap (\(x, (y, z)) -> [(x, y), (x, z)])  
    . mapMaybe (\x -> (x,) <$> findParents x)  
    $ Map.keys dna  
  where  
    findParents x =  
      find (isChild x) $  
        [(y, z) | (y : zs) <- tails $ delete x $ Map.keys dna, z <- zs]  
    isChild x (y, z) =  
      all (\(a, b, c) -> a == b || a == c) $  
        zip3 (dna Map.! x) (dna Map.! y) (dna Map.! z)  

scores :: Map Int [Char] -> Graph -> [Int]  
scores dna relations =  
  [similarity x y * similarity x z | (x, [y, z]) <- assocs relations]  
  where  
    similarity i j =  
      length . filter (uncurry (==)) $ zip (dna Map.! i) (dna Map.! j)  

part1, part2, part3 :: Map Int [Char] -> Int  
part1 = sum . (scores <*> findRelations)  
part2 = part1  
part3 = sum . maximumBy (compare `on` length) . components . findRelations  

main = do  
  readFile "everybody_codes_e2025_q09_p1.txt" >>= print . part1 . readInput  
  readFile "everybody_codes_e2025_q09_p2.txt" >>= print . part2 . readInput  
  readFile "everybody_codes_e2025_q09_p3.txt" >>= print . part3 . readInput  

Nim

Very messy bruteforce.

I’ve had some problems with parsing in part 2 - I didn’t account for double digit numbers before dna sequences and that caused my code to work on example, but silently fail only on the real input. I’ve figured it out after ~30 minutes with some external help.

Part 3 runs in 700ms - not great, but not too bad either.

proc similarity(a, b: string): int =
  for i, c in a:
    if c == b[i]: inc result

proc solve_part1*(input: string): Solution =
  var sim: seq[int]

  var dnaList: seq[string]
  for line in input.splitLines():
    dnaList.add line[2..^1]

  for i in 0 .. dnaList.high:
    for j in i+1 .. dnaList.high:
      let s = similarity(dnaList[i], dnaList[j])
      sim.add s

  sim.sort()
  result := sim[^2] * sim[^1]

proc parentTest(ch, p1, p2: string): bool =
  for i, c in ch:
    if (c != p1[i]) and (c != p2[i]): return false
  true

proc simTable(dnaList: seq[string]): seq[seq[int]] =
  result = newSeqWith(dnaList.len, newseq[int](dnaList.len))
  for i in 0 .. dnaList.high:
    for j in i+1 .. dnaList.high:
      let s = similarity(dnaList[i], dnaList[j])
      result[i][j] = s
      result[j][i] = s

proc solve_part2*(input: string): Solution =
  var dnaList: seq[string]
  for line in input.splitLines():
    dnaList.add line.split(':')[1]

  let sim = simTable(dnaList)
  var indices = toseq(0..dnaList.high)
  for i, childDna in dnaList:
    var indices = indices
    indices.del i

    block doTest:
      for k in 0 .. indices.high:
        for j in k+1 .. indices.high:
          let p1 = indices[k]
          let p2 = indices[j]
          if parentTest(childDna, dnaList[p1], dnaList[p2]):
            result.intVal += sim[i][p1] * sim[i][p2]
            break doTest

proc solve_part3*(input: string): Solution =
  var dnaList: seq[string]
  for line in input.splitLines():
    dnaList.add line.split(':')[1]

  var families: seq[set[int16]]
  var indices = toseq(0..dnaList.high)
  for ch, childDna in dnaList:
    var indices = indices
    indices.del ch

    block doTest:
      for k in 0 .. indices.high:
        for j in k+1 .. indices.high:
          let p1 = indices[k]
          let p2 = indices[j]
          if parentTest(childDna, dnaList[p1], dnaList[p2]):
            families.add {ch.int16, p1.int16, p2.int16}
            break doTest

  var combined: seq[set[int16]]
  while families.len > 0:
    combined.add families.pop()
    var i = 0
    while i <= families.high:
      if (combined[^1] * families[i]).len > 0:
        combined[^1] = combined[^1] + families[i]
        families.del i
        i = 0
      else: inc i

  let maxInd = combined.mapIt(it.len).maxIndex
  result := combined[maxInd].toseq.mapIt(it.int+1).sum()

Full solution at Codeberg: solution.nim