this post was submitted on 14 Nov 2025
3 points (71.4% liked)

Advent Of Code

1122 readers
2 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 2024

Solution Threads

M T W T F S S
1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25

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
 

Quest 9: Encoded in the Scales

  • 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

Link to participate: https://everybody.codes/

you are viewing a single comment's thread
view the rest of the comments
[โ€“] ystael@beehaw.org 2 points 5 days ago (1 children)

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))))))))
[โ€“] hades@programming.dev 1 points 2 days ago

I don't think there's such a thing as a "spirit of the question", but you're free to set your own challenges of course :)