Uiua

[Works on test data, but fails on Part 3 live data: my checksum is "Correct length and correct first character". Posting for the record while I think about it more.] Turned out to be trailing zeros.

F ← (
  ↘1⊙[0_0_0] # Create empty row
  ∧(
    ◡≡([⊃(↧⊃(=0⊢◌|>⊙⊡₁)|=0⊡₁◌|↧⊃(=0⊣◌|<⊙⊡₁))]) # Will it fit in each row?
    ⊟⊙(⊢⊚)⟜⊡⊢⊚⊸≡/↥                             # Find first non-zero row and col.
    (⍜⊡⋅∘)⊙⊃⋅∘∘                                # insert
    ⍥(˜⊂0_0_0)¬≍0_0_0⊸⊣                        # Add padding row back
  )
  ↘¯1
)
S     ← ⋕/$"__"⊡1⍉
Part₁ ← S F
Part₂ ← -⊃/↧/↥≡(S F)

Part₃ ← (
  ⬚0⊸≡(⊂⊃(S|≡(°⊥₁₀▽⊸>₀⇌))F) # All sword stats
  ≡⊂⊙(⊢⍉)             # Append sword IDs
  ⊏⊸⍖                 # Sort
  /+×+1°⊏≡⊣           # Checksum
)

Part₁ [58 5 3 7 8 9 10 4 5 7 8 8]
Part₂ [[2 7 9 9 3 8 3 8 8 6 8] [5 2 9 3 8 3 9 5 2 1 4]]
Part₃ [[1 7 1 9 1 6 9 8 3 7 2]
       [2 7 1 9 1 6 9 8 3 7 2]]

Does anybody miss old-school Lisp mutable data structures where you're kinda a functional language but you still have to worry about the difference between values and object identity? I'm not sure anybody does, but this is a retrocomputing house.

(ql:quickload :str)

(defun parse-line (line)
  (let* ((id-and-nums (str:split ":" line))
         (id (parse-integer (car id-and-nums)))
         (nums (mapcar #'parse-integer (str:split "," (cadr id-and-nums)))))
    (cons id nums)))

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

(defun fishbone-push (fb n)
  (if (null fb)
      (list (vector nil n nil))
      (let ((rib (car fb)))
        (cond ((and (null (aref rib 0))
                    (< n (aref rib 1)))
               (setf (aref rib 0) n)
               fb)
              ((and (null (aref rib 2))
                    (> n (aref rib 1)))
               (setf (aref rib 2) n)
               fb)
              ((null (cdr fb))
               (nconc fb (fishbone-push (cdr fb) n)))
              (t
               (fishbone-push (cdr fb) n)
               fb)))))

(defun make-fishbone (ns)
  (reduce #'fishbone-push ns :initial-value nil))

(defun quality (ns)
  (let ((fb (make-fishbone ns)))
    (parse-integer (apply #'str:concat
                          (mapcar #'(lambda (rib) (write-to-string (aref rib 1)))
                                  fb)))))

(defun main-1 (filename)
  (quality (cdar (read-inputs filename))))

(defun main-2 (filename)
  (let ((qualities (mapcar #'quality (mapcar #'cdr (read-inputs filename)))))
    (- (apply #'max qualities) (apply #'min qualities))))

(defun complex-quality (idx ns)
  (let* ((fb (make-fishbone ns))
         (quality
           (parse-integer (apply #'str:concat
                                 (mapcar #'(lambda (rib) (write-to-string (aref rib 1)))
                                         fb))))
         (rib-qualities
           (mapcar #'(lambda (rib)
                       (parse-integer
                        (apply #'str:concat
                               (mapcar #'write-to-string
                                       (remove-if #'null (coerce rib 'list))))))
                   fb)))
    (list (cons :quality quality)
          (cons :rib-qualities rib-qualities)
          (cons :index idx))))

(defun list> (ns1 ns2)
  (cond ((null ns1) nil)
        ((null ns2) t)
        ((> (car ns1) (car ns2)) t)
        ((< (car ns1) (car ns2)) nil)
        (t (list> (cdr ns1) (cdr ns2)))))

(defun cq> (cq1 cq2)
  (let ((q1 (cdr (assoc :quality cq1)))
        (q2 (cdr (assoc :quality cq2))))
    (cond ((> q1 q2) t)
          ((< q1 q2) nil)
          (t
           (let ((rq1 (cdr (assoc :rib-qualities cq1)))
                 (rq2 (cdr (assoc :rib-qualities cq2))))
             (cond ((list> rq1 rq2) t)
                   ((list> rq2 rq1) nil)
                   (t
                    (> (cdr (assoc :index cq1))
                       (cdr (assoc :index cq2))))))))))

(defun checksum (idxs)
  (loop for idx in idxs
        for n from 1 to (length idxs)
        sum (* idx n)))

(defun main-3 (filename)
  (let ((inputs (read-inputs filename))
        (sword-qualities (make-hash-table)))
    (loop for idx-ns in inputs
          do (setf (gethash (car idx-ns) sword-qualities)
                   (complex-quality (car idx-ns) (cdr idx-ns))))
    (let ((sorted-idxs
            (sort (mapcar #'car inputs)
                  #'(lambda (idx1 idx2)
                      (cq> (gethash idx1 sword-qualities)
                           (gethash idx2 sword-qualities))))))
      (checksum sorted-idxs))))

In 1980 we didn't have tuple or set or vector types. We addressed elements of our cons-based data structures with nonsense incantations like caddar and we liked it that way.

(ql:quickload :cl-ppcre)

(defun read-inputs (filename)
  (mapcar #'parse-integer (uiop:read-file-lines filename)))

(defun main-1 (filename)
  (let ((gears (read-inputs filename)))
    (truncate (* 2025 (/ (first gears) (car (last gears)))))))

(defun main-2 (filename)
  (let ((gears (read-inputs filename)))
    (ceiling (* 10000000000000 (/ (car (last gears)) (first gears))))))

(defun read-inputs-3 (filename)
  (flet ((parse-line (line)
           (or (ppcre:register-groups-bind
                   (a b)
                   ("^([0-9]+)[|]([0-9]+)$" line)
                 (cons (parse-integer a) (parse-integer b)))
               (let ((a (parse-integer line)))
                 (cons a a)))))
    (mapcar #'parse-line (uiop:read-file-lines filename))))

(defun gear-ratio-3 (gears)
  (labels ((iter (gears ratio)
             (if (< (length gears) 2)
                 ratio
                 (let ((out-gear (cdar gears))
                       (in-gear (caadr gears)))
                   (iter (cdr gears) (* ratio (/ out-gear in-gear)))))))
    (iter gears 1)))

(defun main-3 (filename)
  (let ((gears (read-inputs-3 filename)))
    (truncate (* 100 (gear-ratio-3 gears)))))

Common Lisp doesn't have a built in set datatype, so you have to do uniqueness checking sort of by hand unless you want to pull in an external package.

(ql:quickload :str)

(defun read-inputs (filename)
  (let ((input-lines (uiop:read-file-lines filename)))
    (mapcar #'parse-integer (str:split "," (car input-lines)))))

(defun add-distinct (xs)
  (loop for x in (remove-duplicates (sort (copy-seq xs) #'>))
        sum x))

(defun main-1 (filename)
  (add-distinct (read-inputs filename)))

(defun main-2 (filename)
  (let* ((sizes (read-inputs filename))
         (first-20 (subseq (remove-duplicates (sort (copy-seq sizes) #'<)) 0 20)))
    (loop for x in first-20
          sum x)))

(defun count-max-copies (xs)
  (labels ((iter (xs cur-x cur-count max-count)
             (cond ((null xs)
                    max-count)
                   ((equal (car xs) cur-x)
                    (iter (cdr xs) cur-x (1+ cur-count) (max max-count (1+ cur-count))))
                   (t
                    (iter (cdr xs) (car xs) 1 max-count)))))
    (iter (cdr xs) (car xs) 1 1)))

(defun main-3 (filename)
  (count-max-copies (sort (read-inputs filename) #'<)))

I was sad to discover that division wasn't actual complex division. As in some other languages, one has to implement this "division" by hand because the library designers assume that you never want truncating integer division together with complex numbers. Which is reasonable, I guess.

(ql:quickload :cl-ppcre)
(ql:quickload :str)

(defun parse-line (line)
  (ppcre:register-groups-bind
      (name x y)
      ("^([A-Za-z]+)=[[]([\-0-9.]+),([\-0-9.]+)[]]$" line)
    (cons name (complex (parse-integer x) (parse-integer y)))))

(defun read-inputs (filename)
  (let ((input-lines (uiop:read-file-lines filename)))
    (parse-line (car input-lines))))

(defun fake-complex-division (y d)
  (complex (truncate (realpart y) (realpart d))
           (truncate (imagpart y) (imagpart d))))

(defun f (x a)
  (+ a (fake-complex-division (* x x) #C(10 10))))

(defun main-1 (filename)
  (let* ((a (cdr (read-inputs filename)))
         (result (f (f (f #C(0 0) a) a) a)))
    (str:concat "["
                (write-to-string (realpart result))
                ","
                (write-to-string (imagpart result))
                "]")))

(defun engrave? (p)
  (labels ((iter (x n)
             (if (zerop n)
                 t
                 (let ((next-x (+ p (fake-complex-division (* x x) #C(100000 100000)))))
                   (if (or (> (abs (realpart next-x)) 1000000)
                           (> (abs (imagpart next-x)) 1000000))
                       nil
                       (iter next-x (- n 1)))))))
    (iter 0 100)))

(defun count-engraves (a spacing)
  (let ((steps (/ 1000 spacing)))
    (loop for x from 0 to steps
          sum (loop for y from 0 to steps
                    for p = (+ a (complex (* spacing x) (* spacing y)))
                    sum (if (engrave? p) 1 0)))))

(defun main-2 (filename)
  (count-engraves (cdr (read-inputs filename)) 10))

(defun main-3 (filename)
  (count-engraves (cdr (read-inputs filename)) 1))

It's been too long since I wrote any Lisp, so obviously I should use the one hallowed by decades of tradition, not any of the fancy new ones with sane naming conventions and unified library systems. :D

(ql:quickload :str)

(defun parse-insn (insn)
  (let ((direction (str:s-first insn))
        (magnitude (parse-integer (str:s-rest insn))))
    (* magnitude (cond ((equal direction "L") -1)
                       ((equal direction "R") 1)
                       (t 0)))))

(defun read-inputs-1 (filename)
  (let ((input-lines (uiop:read-file-lines filename)))
    (destructuring-bind (names _ instructions) input-lines
      (list (str:split "," names)
            (mapcar #'parse-insn (str:split "," instructions))))))

(defun apply-insns-1 (names insns)
  (let ((max-pos (- (length names) 1)))
    (labels ((apply-from (insns pos)
               (if (null insns)
                   (nth pos names)
                   (let* ((maybe-next-pos (+ pos (car insns)))
                          (next-pos (max 0 (min max-pos maybe-next-pos))))
                     (apply-from (cdr insns) next-pos)))))
      (apply-from insns 0))))

(defun main-1 (filename)
  (apply #'apply-insns-1 (read-inputs-1 filename)))

(defun apply-insns-2 (names insns)
  (labels ((apply-from (insns pos)
             (if (null insns)
                 (nth pos names)
                 (let ((next-pos (mod (+ pos (car insns)) (length names))))
                   (apply-from (cdr insns) next-pos)))))
    (apply-from insns 0)))

(defun main-2 (filename)
  (apply #'apply-insns-2 (read-inputs-1 filename)))

(defun apply-insns-3 (names insns)
  (let* ((vnames (coerce names 'vector))
         (n (length vnames)))
    (labels ((apply-from (insns)
               (if (null insns)
                   (aref vnames 0)
                   (let* ((tgt (mod (car insns) n))
                          (src-name (aref vnames 0))
                          (tgt-name (aref vnames tgt)))
                     (setf (aref vnames 0) tgt-name)
                     (setf (aref vnames tgt) src-name)
                     (apply-from (cdr insns))))))
      (apply-from insns))))

(defun main-3 (filename)
  (apply #'apply-insns-3 (read-inputs-1 filename)))

Uiua

Fortunately the ratios for the common gears all proved to be rational in part 3.

⌊×2025/÷⊏¯1_0[128 64 32 16 8]              # ->32400
⌈×⊙÷°⊟⊏¯1_0⊙10000000000000[128 64 32 16 8] # -> 625000000000
⊜□⊸≠@\s "5 5|10 10|20 5"
⌊×100×⊃(÷∩⋕⊃⊣⊢|/×≡◇(/÷⊜⋕⊸≠@|)↘1↘¯1) # -> 400

Very simple task for Uiua.

[10 5 1 10 3 8 5 2 2]
/+◴
[4 51 13 64 57 51 82 57 16 88 89 48 32 49 49 2 84 65 49 43 9 13 2 3 75 72 63 48 61 14 40 77]
/+↙20⍆⊸◴
/↥⊜⧻⊸∘⍆

-> 29, 781, 3

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

Nim

Part 2 - I just really didn't want to think that day. So when puzzle asked me to check if lines intersect - I wrote the intersection checking solution with 2D points.

Part 3 is geometry + bruteforce.

proc solve_part1*(input: string): Solution =
  let pins = input.split(',').mapIt(parseInt(it))
  for i in 0 ..< pins.high:
    let d = abs(pins[i] - pins[i+1])
    if d == 16: inc result.intVal

proc ccw(A,B,C: Vec2): bool = (C.y-A.y) * (B.x-A.x) > (B.y-A.y) * (C.x-A.x)
proc isIntersection(A,B,C,D: Vec2): bool = ccw(A,C,D) != ccw(B,C,D) and ccw(A,B,C) != ccw(A,B,D)

proc solve_part2*(input: string): Solution =
  const two_pi = PI * 2
  const pin_count = 256

  var pins: array[pin_count, Vec2]
  for i in 0 ..< pin_count:
    let angle = two_pi * (i / pin_count)
    let point: Vec2 = (cos(angle), sin(angle))
    pins[i] = point

  let inst = input.split(',').mapIt(parseInt(it))
  var lines: seq[(Vec2, Vec2)]

  for i in 0 ..< inst.high:
    let A = pins[inst[i]-1]
    let B = pins[inst[i+1]-1]

    for (C, D) in lines:
      if isIntersection(A,B,C,D):
        inc result.intVal
    lines.add shortenSegment(A, B, 0.0001)

proc solve_part3*(input: string): Solution =
  const two_pi = PI * 2
  const pin_count = 256

  var pins: array[pin_count, Vec2]
  for i in 0 ..< pin_count:
    let angle = two_pi * (i / pin_count)
    let point: Vec2 = (cos(angle), sin(angle))
    pins[i] = point

  let inst = input.split(',').mapIt(parseInt(it))
  var lines: seq[(Vec2, Vec2)]

  for i in 0 ..< inst.high:
    let A = pins[inst[i]-1]
    let B = pins[inst[i+1]-1]
    lines.add shortenSegment(A, B, 0.0001)

  var bestSum = 0
  for i in 0 ..< pin_count:
    for j in i+1 ..< pin_count:
      let A = pins[i]
      let B = pins[j]
      var sum = 0
      for (C, D) in lines:
        if isIntersection(A,B,C,D): inc sum
      if sum > bestSum: bestSum = sum
  result := bestSum

Full solution at Codeberg: solution.nim

Nim

Part 3 is a recursive solution with caching (memoization).

proc isValid(name: string, rules: Table[char, set[char]]): bool =
  for i in 0 ..< name.high:
    if name[i+1] notin rules[name[i]]: return false
  true

proc allNames(prefix: string, rules: Table[char, set[char]], range: Slice[int]): int =
  var memo {.global.}: Table[(int, char), int]
  if prefix.len >= range.b: return
  if (prefix.len, prefix[^1]) in memo: return memo[(prefix.len, prefix[^1])]

  for ch in rules.getOrDefault(prefix[^1]):
    if prefix.len + 1 >= range.a:
      inc result
    result += allNames(prefix & ch, rules, range)

  memo[(prefix.len, prefix[^1])] = result

proc solve_part1*(input: string): Solution =
  let (names, rules) = parseInput(input)
  for name in names:
    if name.isValid(rules):
      return Solution(kind: skString, strVal: name)

proc solve_part2*(input: string): Solution =
  let (names, rules) = parseInput(input)
  for ni, name in names:
    if name.isValid(rules):
      result.intVal += ni + 1

proc solve_part3*(input: string): Solution =
  let (names, rules) = parseInput(input)
  var seen: seq[string]
  for name in names:
    if not name.isValid(rules): continue
    if seen.anyIt(name.startsWith it): continue
    result.intVal += allNames(name, rules, 7..11)
    seen.add name

Full solution at Codeberg: solution.nim

Nim

parts 1 and 2 - easy

For part 3 - When I first looked at the example input - it seemed a bit daunting to solve. But then I had a hunch and decided to check the real input and turns out - I was right! The real input is easier to solve because it's longer than 1000 chars.

This means that there is only 3 possible configurations we care about in repeated input: leftmost section, rightmost section and 998 identical sections in the middle. We solve each individually and sum them.

Another trick I used is looking up mentors with modulo to avoid copying the input.

proc solve_part1*(input: string): Solution =
  var mentors: CountTable[char]
  for c in input:
    if c notin {'a','A'}: continue
    if c.isUpperAscii: mentors.inc c
    else:
      result.intVal += mentors.getOrDefault(c.toUpperAscii)

proc solve_part2*(input: string): Solution =
  var mentors: CountTable[char]
  for c in input:
    if c.isUpperAscii: mentors.inc c
    else:
      result.intVal += mentors.getOrDefault(c.toUpperAscii)

proc solve_part3*(input: string): Solution =
  var mentors: Table[char, seq[int]]
  for index in -1000 ..< input.len + 1000:
    let mi = index.euclMod input.len
    if input[mi].isLowerAscii: continue
    let lower = input[mi].toLowerAscii
    if mentors.hasKeyOrPut(lower, @[index]):
      mentors[lower].add index

  var most, first, last = 0
  for ci, ch in input:
    if ch.isUpperAscii: continue
    for mi in mentors[ch]:
      let dist = abs(mi - ci)
      if dist <= 1000:
        inc most
        if mi >= 0: inc first
        if mi <= input.high: inc last

  result := first + (most * 998) + last

Full solution at Codeberg: solution.nim

Sadly Uiua doesn't handle the large numbers here well, so here's a Dart solution instead.

import 'dart:math';
import 'package:more/more.dart';

typedef P = Point;
void main(List<String> args) {
  P add(P a, P b) => P(a.x + b.x, a.y + b.y);
  P mul(P a, P b) => P(a.x * b.x - a.y * b.y, a.x * b.y + a.y * b.x);
  P div(P a, P b) => P(a.x ~/ b.x, a.y ~/ b.y);
  P part1(P a) {
    P r = P(0, 0);
    for (var _ in 0.to(3)) {
      r = add(div(mul(r, r), P(10, 10)), a);
    }
    return r;
  }

  bool test2(P a) {
    P r = P(0, 0);
    for (var _ in 0.to(100)) {
      r = add(div(mul(r, r), P(100000, 100000)), a);
      if (r.x.abs() > 1000000 || r.y.abs() > 1000000) return false;
    }
    return true;
  }

  part2(P a, {step = 1}) => [
        for (var x in 0.to(1001, step: step))
          for (var y in 0.to(1001, step: step)) test2(P(a.x + x, a.y + y))
      ].count((e) => e);

  print(part1(P(25, 9)));
  print(part2(P(35300, -64910), step: 10));
  print(part2(P(35300, -64910)));
}

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  

What a fiddlybit. I needed records to save me from list-hell on this one.

Scheme/Guile

(import (rnrs io ports (6))
        (rnrs records syntactic))

(define (parse-file file-name)
  (let* ((lines (string-split (string-trim-both (call-with-input-file file-name get-string-all)) #\newline)))
    (map (lambda (line)
       (let* ((colon-split (string-split line #\:))
             (segments (map string->number (string-split (cadr colon-split) #\,)))
             (label (string->number (car colon-split))))
        (cons label segments)))
       lines)))

(define-record-type fishbone-segment (fields middle left right))
(define (construct-fishbone fishbone segments)
  (if (null? segments)
      fishbone
      (let ((fishbone (add-fishbone-segment fishbone (car segments))))
        (construct-fishbone fishbone (cdr segments)))))
(define (add-fishbone-segment fishbone segment)
  (if (null? fishbone)
      (list (make-fishbone-segment segment #f #f))
      (let* ((fish-head (car fishbone))
             (fish-middle (fishbone-segment-middle fish-head))
             (fish-left (fishbone-segment-left fish-head))
             (fish-right (fishbone-segment-right fish-head)))
        (cond
          ((and (< segment fish-middle) (not fish-left)) (cons (make-fishbone-segment fish-middle segment fish-right) (cdr fishbone)))
          ((and (> segment fish-middle) (not fish-right)) (cons (make-fishbone-segment fish-middle fish-left segment) (cdr fishbone)))
          (else (cons fish-head (add-fishbone-segment (cdr fishbone) segment)))))))
(define (score-fishbone fishbone)
  (string->number (string-join (map (compose number->string fishbone-segment-middle) fishbone) "")))

(define-record-type sword (fields id fishbone quality))
(define (parse-swords file-name)
  (map (lambda (sword-line)
          (let ((fishbone (construct-fishbone '() (cdr sword-line))))
            (make-sword (car sword-line) fishbone (score-fishbone fishbone))))
    (parse-file file-name)))

(format #t "P1 Answer: ~a\n\n" (sword-quality (car (parse-swords "notes/everybody_codes_e2025_q05_p1.txt"))))

(let* ((swords (parse-swords "notes/everybody_codes_e2025_q05_p2.txt"))
       (sword-scores (map sword-quality swords)))
  (format #t "P2 Answer: ~a\n\n" (- (apply max sword-scores) (apply min sword-scores))))


(define (segment-score segment)
  (string->number
    (string-join
     (map (lambda (n) (if (eqv? #f n) "" (number->string n)))
      (list (fishbone-segment-left segment) (fishbone-segment-middle segment) (fishbone-segment-right segment)))
     "")))
(define (sort-fishbones a b)
  (if (null? a) '()
  (let ((line-score-a (segment-score (car a)))
        (line-score-b (segment-score (car b))))
    (cond
      ((> line-score-a line-score-b) #t)
      ((< line-score-a line-score-b) #f)
      (else (sort-fishbones (cdr a) (cdr b)))))))
(define (sort-swords a b)
  (cond
    ((> (sword-quality a) (sword-quality b)) #t)
    ((< (sword-quality a) (sword-quality b)) #f)
    (else (let ((fb-sort (sort-fishbones (sword-fishbone a) (sword-fishbone b))))
      (cond
        ((null? fb-sort) (> (sword-id a) (sword-id b)))
        (else fb-sort))))))
(let* ((swords (parse-swords "notes/everybody_codes_e2025_q05_p3.txt"))
       (sorted-swords (sort swords sort-swords))
       (swords-length (length swords)))
  (let loop ((i 1) (total 0) (sorted-swords sorted-swords))
    (if (<= i swords-length)
        (loop (1+ i) (+ total (* i (sword-id (car sorted-swords)))) (cdr sorted-swords))
        (format #t "P2 Answer: ~a\n\n" total))))

maaath

Scheme/Guile

(import (rnrs io ports (6)))

(define (parse-file file-name)
       (map string->number (string-split (call-with-input-file file-name get-string-all) #\newline)))

(let* ((gears (parse-file "notes/everybody_codes_e2025_q04_p1.txt")))
  (format #t "P1 Answer: ~a\n\n" (* 2025 (/ (car gears) (car (last-pair gears))))))


(let* ((gears (parse-file "notes/everybody_codes_e2025_q04_p2.txt")))
  (format #t "P2 Answer: ~a\n\n" (ceiling (* 10000000000000 (/ (car (last-pair gears)) (car gears))))))


(define (parse-file-p3 file-name)
       (map
              (lambda (line) (map string->number(string-split line #\|)))
              (string-split (call-with-input-file file-name get-string-all) #\newline)))
(let* ((gears (parse-file-p3 "notes/everybody_codes_e2025_q04_p3.txt")))
  (format #t "P2 Answer: ~a\n\n"
          (floor (* 100
             (apply * (map (lambda (gear) (if (= 1 (length gear)) 1 (/ (cadr gear) (car gear)))) gears))
             (/ (caar gears) (caar (last-pair gears)))))))

Haskell

Woo! I got on the leaderboard at last. I don't think I've seen a problem like this one before, but fortunately it wasn't as tricky as it seemed at first glance.

import Control.Monad  
import Data.List  
import Data.List.Split  
import Data.Tuple  

readInput :: String -> [(Int, Int)]  
readInput = map fixOrder . (zip <*> tail) . map read . splitOn ","  
  where  
    fixOrder (x, y)  
      | x > y = (y, x)  
      | otherwise = (x, y)  

crosses (a, b) (c, d) =  
  not (a == c || a == d || b == c || b == d)  
    && ((a < c && c < b) /= (a < d && d < b))  

part1 n = length . filter ((== n `quot` 2) . uncurry (-) . swap)  

part2 n = sum . (zipWith countKnots <*> inits)  
  where  
    countKnots x strings = length $ filter (crosses x) strings  

part3 n strings =  
  maximum [countCuts (a, b) | a <- [1 .. n - 1], b <- [a + 1 .. n]]  
  where  
    countCuts x = length $ filter (\s -> x == s || x `crosses` s) strings  

main =  
  forM_  
    [ ("everybody_codes_e2025_q08_p1.txt", part1 32),  
      ("everybody_codes_e2025_q08_p2.txt", part2 256),  
      ("everybody_codes_e2025_q08_p3.txt", part3 256)  
    ]  
    $ \(input, solve) -> readFile input >>= print . solve . readInput  

Haskell

A nice dynamic programming problem in part 3.

import Data.List  
import Data.List.Split  
import Data.Map.Lazy qualified as Map  
import Data.Maybe  

readInput s =  
  let (names : _ : rules) = lines s  
   in (splitOn "," names, map readRule rules)  
  where  
    readRule s =  
      let [[c], post] = splitOn " > " s  
       in (c, map head $ splitOn "," post)  

validBy rules name = all (`check` name) rules  
  where  
    check (c, cs) = all (`elem` cs) . following c  
    following c s = [b | (a : b : _) <- tails s, a == c]  

part1 (names, rules) = fromJust $ find (validBy rules) names  

part2 (names, rules) =  
  sum $ map fst $ filter (validBy rules . snd) $ zip [1 ..] names  

part3 (names, rules) =  
  sum . map go . filter (validBy rules) $ dedup names  
  where  
    dedup xs =  
      filter (\x -> not $ any (\y -> x /= y && y `isPrefixOf` x) xs) xs  
    go n = count (length n) (last n)  
    gen 11 _ = 1  
    gen len c =  
      (if len >= 7 then (1 +) else id)  
        . maybe 0 (sum . map (count (len + 1)))  
        $ lookup c rules  
    count =  
      curry . (Map.!) . Map.fromList $  
        [ ((k, c), gen k c)  
          | k <- [1 .. 11],  
            c <- map fst rules ++ concatMap snd rules  
        ]  

main = do  
  readFile "everybody_codes_e2025_q07_p1.txt" >>= putStrLn . part1 . readInput  
  readFile "everybody_codes_e2025_q07_p2.txt" >>= print . part2 . readInput  
  readFile "everybody_codes_e2025_q07_p3.txt" >>= print . part3 . readInput  

Haskell

It took me an embarrassingly long time to figure out what was going on with this one.

You could go a bit faster by splitting the list into beginning/middle/end parts, but I like the simplicity of this approach.

import Control.Monad (forM_)  
import Data.Char (toUpper)  
import Data.IntMap.Strict qualified as IntMap  
import Data.List (elemIndices)  
import Data.Map qualified as Map  

{-  
  f is a function which, given a lookup function and an index  
  returns the number of mentors for the novice at that position.  
  The lookup function returns the number of knights up to but  
  not including a specified position.  
-}  
countMentorsWith f input = Map.fromList [(c, go c) | c <- "abc"]  
  where  
    go c =  
      let knights = elemIndices (toUpper c) input  
          counts = IntMap.fromDistinctAscList $ zip knights [1 ..]  
          preceding = maybe 0 snd . (`IntMap.lookupLT` counts)  
       in sum $ map (f preceding) $ elemIndices c input  

part1 = (Map.! 'a') . countMentorsWith id  

part2 = sum . countMentorsWith id  

part3 d r = sum . countMentorsWith nearby . concat . replicate r  
  where  
    nearby lookup i = lookup (i + d + 1) - lookup (i - d)  

main =  
  forM_  
    [ ("everybody_codes_e2025_q06_p1.txt", part1),  
      ("everybody_codes_e2025_q06_p2.txt", part2),  
      ("everybody_codes_e2025_q06_p3.txt", part3 1000 1000)  
    ]  
    $ \(input, solve) -> readFile input >>= print . solve  

:-(

^ not valid Uiua code

ah, uiua, the only thing that makes me wish Unicode hadn't been invented :)

Short and simple Uiua solution :-)

Data ← {"Vyrdax,Drakzyph,Fyrryn,Elarzris"
        "R3,L2,R3,L1"}
Prep    ← ⊜□⊸≠@,°□⊣⟜(+1/+˜=@,°□⊢)
Present ← °□˜⊡⊜□⊸≠@,°□⊢Data⊙◌
Part₁   ← ∧(↧⊙(⊸-₁)↥0+⍥¯=@L⊙⋕°⊂°□)⊙0
Part₂   ← ∧(˜◿⊙⟜∘+⍥¯=@L⊙⋕°⊂°□)⊙0
Present Part₁ Prep Data
Present Part₂ Prep Data
Data ← {"Vyrdax,Drakzyph,Fyrryn,Elarzris"
        "R3,L2,R3,L3"}
∩(⊜□⊸≠@,)∩°□°⊟⇌Data
°□⊢∧(⍜⊏⇌⊂0◿(⧻⊃⋅∘⊙∘)⍥¯=@L⊙⋕°⊂°□)

-> "Fyrryn", "Elarzris", "Drakzyph"

Rust

pub fn solve_part_1(input: &str) -> String {
    let numbers: Vec<i32> = input.split(",").map(|x| x.parse().unwrap()).collect();
    let mut count = 0;
    for i in 1..numbers.len() {
        if numbers[i].abs_diff(numbers[i - 1]) == 16 {
            count += 1;
        }
    }
    count.to_string()
}

pub fn solve_part_2(input: &str) -> String {
    let numbers: Vec<i32> = input.split(",").map(|x| x.parse().unwrap()).collect();
    let mut lines: Vec<(i32, i32)> = vec![];
    for i in 1..numbers.len() {
        let (a, b) = (numbers[i - 1], numbers[i]);
        if a > b {
            lines.push((b, a));
        } else {
            lines.push((a, b));
        }
    }
    let mut knots = 0;
    for i in 0..lines.len() {
        for j in 0..i {
            let (a, b) = lines[i];
            let (c, d) = lines[j];
            if a == c || a == d || b == c || b == d {
                continue;
            }
            let c_inside = c > a && c < b;
            let d_inside = d > a && d < b;
            if c_inside != d_inside {
                knots += 1;
            }
        }
    }
    knots.to_string()
}

pub fn solve_part_3(input: &str) -> String {
    let numbers: Vec<i32> = input.split(",").map(|x| x.parse().unwrap()).collect();
    let mut lines: Vec<(i32, i32)> = vec![];
    for i in 1..numbers.len() {
        let (a, b) = (numbers[i - 1], numbers[i]);
        if a > b {
            lines.push((b, a));
        } else {
            lines.push((a, b));
        }
    }
    let mut best_cut_threads = i64::MIN;
    for d in 1..=256 {
        for c in 1..d {
            let mut cut_threads = 0;
            for (a, b) in lines.iter().copied() {
                if a == c || a == d || b == c || b == d {
                    if a == c && b == d {
                        cut_threads += 1;
                    }
                    continue;
                }
                let c_inside = c > a && c < b;
                let d_inside = d > a && d < b;
                if c_inside != d_inside {
                    cut_threads += 1;
                }
            }
            if cut_threads > best_cut_threads {
                best_cut_threads = cut_threads;
            }
        }
    }
    best_cut_threads.to_string()
}

Rust

Technically you don't need to store the names in part 3, but I was too lazy.

use std::collections::{HashMap, HashSet};

pub fn solve_part_1(input: &str) -> String {
    let (names, rules) = input.split_once("\n\n").unwrap();
    let names: Vec<&str> = names.split(",").collect();
    let rules: HashMap<char, HashSet<char>> = rules
        .lines()
        .map(|line| {
            let (from, to) = line.split_once(" > ").unwrap();
            let to = to.split(",");
            (
                from.chars().next().unwrap(),
                to.map(|s| s.chars().next().unwrap()).collect(),
            )
        })
        .collect();
    for name in names {
        let mut allowed_chars = rules.get(&name.chars().next().unwrap());
        let mut acceptable = true;
        for ch in name.chars().skip(1) {
            match allowed_chars {
                Some(allowed) => {
                    if !allowed.contains(&ch) {
                        acceptable = false;
                        break;
                    }
                    allowed_chars = rules.get(&ch);
                }
                None => {
                    panic!("no rules for letter {ch} in name {name}");
                }
            }
        }
        if acceptable {
            return name.to_string();
        }
    }
    panic!("all names bad");
}

pub fn solve_part_2(input: &str) -> String {
    let (names, rules) = input.split_once("\n\n").unwrap();
    let names: Vec<&str> = names.split(",").collect();
    let rules: HashMap<char, HashSet<char>> = rules
        .lines()
        .map(|line| {
            let (from, to) = line.split_once(" > ").unwrap();
            let to = to.split(",");
            (
                from.chars().next().unwrap(),
                to.map(|s| s.chars().next().unwrap()).collect(),
            )
        })
        .collect();
    let mut sum_of_indices = 0;
    for (i, name) in names.into_iter().enumerate() {
        let mut allowed_chars = rules.get(&name.chars().next().unwrap());
        let mut acceptable = true;
        for ch in name.chars().skip(1) {
            match allowed_chars {
                Some(allowed) => {
                    if !allowed.contains(&ch) {
                        acceptable = false;
                        break;
                    }
                    allowed_chars = rules.get(&ch);
                }
                None => {
                    panic!("no rules for letter {ch} in name {name}");
                }
            }
        }
        if acceptable {
            sum_of_indices += 1 + i;
        }
    }
    sum_of_indices.to_string()
}

fn gen_names_with_prefix(
    prefix: &str,
    rules: &HashMap<char, HashSet<char>>,
    result: &mut HashSet<String>,
) {
    if prefix.len() >= 7 {
        result.insert(prefix.to_string());
    }
    if prefix.len() == 11 {
        return;
    }
    let last_char = prefix.chars().last().unwrap();
    if let Some(next_chars) = rules.get(&last_char) {
        for next_char in next_chars {
            let new_prefix = format!("{prefix}{next_char}");
            gen_names_with_prefix(new_prefix.as_str(), rules, result);
        }
    }
}

pub fn solve_part_3(input: &str) -> String {
    let (prefix, rules) = input.split_once("\n\n").unwrap();
    let prefixes: Vec<_> = prefix.split(",").collect();
    let rules: HashMap<char, HashSet<char>> = rules
        .lines()
        .map(|line| {
            let (from, to) = line.split_once(" > ").unwrap();
            let to = to.split(",");
            (
                from.chars().next().unwrap(),
                to.map(|s| s.chars().next().unwrap()).collect(),
            )
        })
        .collect();
    let mut results: HashSet<String> = HashSet::new();
    prefixes
        .into_iter()
        .filter(|&name| {
            let mut allowed_chars = rules.get(&name.chars().next().unwrap());
            let mut acceptable = true;
            for ch in name.chars().skip(1) {
                match allowed_chars {
                    Some(allowed) => {
                        if !allowed.contains(&ch) {
                            acceptable = false;
                            break;
                        }
                        allowed_chars = rules.get(&ch);
                    }
                    None => {
                        panic!("no rules for letter {ch} in name {name}");
                    }
                }
            }
            acceptable
        })
        .for_each(|prefix| gen_names_with_prefix(prefix, &rules, &mut results));
    results.len().to_string()
}

Rust

use std::collections::HashMap;
use itertools::Itertools;

pub fn solve_part_1(input: &str) -> String {
    let mut mentors = 0;
    let mut pairs = 0;
    for ch in input.chars() {
        match ch {
            'A' => mentors += 1,
            'a' => pairs += mentors,
            _ => {}
        }
    }
    pairs.to_string()
}

pub fn solve_part_2(input: &str) -> String {
    let mut mentors: HashMap<char, i64> = HashMap::new();
    let mut pairs = 0;
    for ch in input.chars() {
        match ch {
            'A'..='Z' => *mentors.entry(ch).or_default() += 1,
            'a'..='z' => pairs += *mentors.entry(ch.to_ascii_uppercase()).or_default(),
            _ => panic!("unexpected character {ch}"),
        }
    }
    pairs.to_string()
}

pub fn solve_part_3(input: &str) -> String {
    let data: Vec<_> = input.chars().collect();
    let len = data.len();
    let mentors: HashMap<char, Vec<usize>> = data
        .iter()
        .enumerate()
        .map(|(i, ch)| (*ch, i))
        .into_group_map();
    let mut pairs: i64 = 0;
    for (squire_position, ch) in data.into_iter().enumerate() {
        if ch.is_ascii_lowercase() {
            for mentor_position in mentors.get(&ch.to_ascii_uppercase()).unwrap() {
                if squire_position.abs_diff(*mentor_position) <= 1000 {
                    pairs += 1000;
                } else if (squire_position as isize)
                    .wrapping_sub_unsigned(len)
                    .abs_diff(*mentor_position as isize)
                    <= 1000
                    || (*mentor_position as isize)
                        .wrapping_sub_unsigned(len)
                        .abs_diff(squire_position as isize)
                        <= 1000
                {
                    pairs += 999;
                }
            }
        }
    }
    pairs.to_string()
}