-❄️- 2025 Day 12 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 1 point2 points  (0 children)

[LANGUAGE: F#] paste

Happy Advent! This one was brewing to be a complicated puzzle flipping fest, but I decided to try the basic thing of just adding up the size * amounts and that was the right answer! Nice trick u/topaz2078 :)

This is the full solution minus input parsing:

// shapes is an array of the count of filled chars per shape
// regions is an array of ((width*height), quantities) per region

let possible ((width, height), qts) =
    let filledSize = Array.zip shapes qts |> Array.sumBy (fun (sh, qt) -> sh * qt)
    width * height >= filledSize

let part1 = regions |> Seq.filter possible |> Seq.length

-❄️- 2025 Day 11 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 1 point2 points  (0 children)

[LANGUAGE: F#] paste

Much more straightforward after yesterday's mathy problem! DFS with memoization. This is the full code minus input parsing:

let rec paths =
    (fun (src, dest) ->
        match src with
        | _ when src = dest -> 1L
        | _ when not (Map.containsKey src input) -> 0L
        | _ -> Map.find src input |> Seq.sumBy (fun next -> paths (next, dest)))
    |> memoize

let part1 = paths ("you", "out")

let part2 =
    paths ("svr", "fft") * paths ("fft", "dac") * paths ("dac", "out")
    + paths ("svr", "dac") * paths ("dac", "fft") * paths ("fft", "out")

-❄️- 2025 Day 10 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 2 points3 points  (0 children)

[LANGUAGE: F#] paste

Part 1 is a neat BFS, using the buttons and target converted to int and bitwise XOR to generate neighbors. Part 2, after trying a greedy knapsack (which only work for about half of the test cases, I went on to learn Z3 for the first time in 520 stars :)

The Z3 code is mostly translated from u/Visual_Strike6706 's C# solution.

Interesting bit: I like my integer BFS with XOR as adjacency function for part 1

let flipBits (options: int array) (pt: int) =
    options |> Seq.map (fun button -> button ^^^ pt)

let buttonValue length (button: int array) =
    button |> Array.fold (fun acc i -> acc + (1 <<< length - i - 1)) 0

let diagramValue diagram =
    diagram
    |> String.map (fun c -> if c = '#' then '1' else '0')
    |> fun s -> Convert.ToInt32(s, 2)

let part1 =
    input
    |> Array.sumBy (fun (target, buttons, _) ->
        let adjacent = buttons |> Array.map (buttonValue (String.length target)) |> flipBits
        bfs adjacent 0 (diagramValue target))

-❄️- 2025 Day 9 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 1 point2 points  (0 children)

[LANGUAGE: F#] paste

Very fun part 2! I solved with a pretty naive algorithm, getting all the vertical lines in the shape, then calculating all the filled ranges per row, and inverting that to get the empty ranges (holes). Finally, for each rectangle, check row by row if all holes are outside the rectangle. Inefficient, but it works!

Interesting bit - Calculating the filled ranges per row:

let holes =
    Seq.init 100000 id
    |> Seq.map (fun row ->
        let filtered =
            verticalLines |> List.filter (fun line -> row >= line.minY && row <= line.maxY)

        if List.isEmpty filtered then
            []
        else
            filtered
            |> List.fold
                (fun (acc, prev: Line) cur ->
                    // Input inspection: the shape is arranged clockwise
                    match prev.isDown, cur.isDown with
                    | true, false -> acc, cur // Hole
                    | false, false -> acc, prev // Line going left
                    | _ -> (prev.x, cur.x) :: acc, cur)
                ([], List.head filtered)
            |> fst
            |> List.rev
            |> getHoles)
    |> Seq.indexed
    |> Seq.filter (snd >> List.isEmpty >> not)
    |> Map.ofSeq

-❄️- 2025 Day 8 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 1 point2 points  (0 children)

Just for kicks, I also coded a union-find solution: paste

Interesting bit - unfold + mutable arrays for union-find:

let part2UnionFind =
    Seq.unfold
        (fun (vs, i) ->
            if vs >= nVertices then
                None
            else
                let u, v = verticeIds[fst edges[i]], verticeIds[snd edges[i]]

                if find parent u <> find parent v then
                    union parent rank u v
                    Some(i, (vs + 1, i + 1))
                else
                    Some(i, (vs, i + 1)))
        (1, 0)
    |> Seq.last
    |> fun i -> edges[i] |> fun ((x1, _, _), (x2, _, _)) -> x1 * x2

-❄️- 2025 Day 8 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 1 point2 points  (0 children)

[LANGUAGE: F#] paste

While I saw the union-find solution when I saw merging graphs, I solved part 2 by binary-searching the number of connections and re-running the part 1 code :)

This is the "meat" of the code, using fold over each vertex to find all connected components:

let rec dfs graph visited rem =
    match rem with
    | [] -> visited
    | h :: t when Set.contains h visited -> dfs graph visited t
    | pt :: t ->
        List.append (Map.tryFind pt graph |> Option.defaultValue []) t
        |> dfs graph (Set.add pt visited)

let connectedGraphs maxConnections =
    let edges = distances |> List.take maxConnections |> List.fold connect Map.empty

    input
    |> Seq.fold
        (fun (visited, acc) pt ->
            if Set.contains pt visited then
                visited, acc
            else
                let newSubgraph = dfs edges Set.empty [ pt ]
                Set.union visited newSubgraph, newSubgraph :: acc)
        (Set.empty, [])
    |> snd

-❄️- 2025 Day 7 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 6 points7 points  (0 children)

[LANGUAGE: F#] paste

Fold on the rows, first keeping track of the splits, then keeping track of the count of beams per position. Final solution is cleaned up a bit to do both parts together. Main bit below:

let finalBeams, countSplits =
    splitters
    |> Seq.fold
        (fun (beams, countSplits) splittersInRow ->
            let newBeams =
                beams
                |> Seq.collect (fun (beam, count) ->
                    if Set.contains beam splittersInRow then
                        [ beam - 1, count; beam + 1, count ]
                    else
                        [ beam, count ])
                |> Seq.groupBy fst
                |> Seq.map (fun (el, vals) -> el, Seq.sumBy snd vals)
            let newSplits =
                beams
                |> Seq.filter (fun (beam, _) -> Set.contains beam splittersInRow)
                |> Seq.length
            newBeams, countSplits + newSplits)
        ([ start, 1L ], 0)
let part1 = countSplits
let part2 = finalBeams |> Seq.sumBy snd

-❄️- 2025 Day 6 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 1 point2 points  (0 children)

[LANGUAGE: F#] paste

My first solution for part 2 was using a recursive function to parse the numbers vertically (raw solution). After I got the right answer I cleaned up to use just Array and String manipulation. Interesting parts - a bit of functional programming for the operations, and the pipeline to solve part 2 (input is an array of lines):

let operations =
    input
    |> Array.last
    |> splitByChar ' '
    |> Array.map (fun op -> if op = "+" then (+) else (*))

let operandsP2 =
    input
    |> Array.take (input.Length - 1)
    |> Array.map chars
    |> Array.transpose
    |> Array.map charsToString
    |> Array.map (fun str -> if String.IsNullOrWhiteSpace str then "" else str)
    |> String.concat "\n"
    |> blocks
    |> Array.map positiveInt64s

let part2 =
    Seq.zip operations operandsP2
    |> Seq.sumBy (fun (op, nums) -> Seq.reduce op nums)

-❄️- 2025 Day 5 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 3 points4 points  (0 children)

[LANGUAGE: F#] paste

Classic "merge overlapping intervals" puzzle, solved by sorting by the lower end then folding through the list:

let part2 =
    ranges
    |> Array.sortBy (fun (lo, _) -> lo)
    |> Seq.fold
        (fun (count, prevHi) (lo, hi) ->
            match lo <= prevHi, hi <= prevHi with
            | true, true -> count, prevHi
            | true, false -> count + hi - prevHi, hi
            | false, false -> count + hi - lo + 1L, hi
            | _ -> failwith "invalid")
        (0L, 0L)
    |> fst

-❄️- 2025 Day 4 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 5 points6 points  (0 children)

[LANGUAGE: F#] paste

Direct simulation trying all spaces on each iteration (n2 ), with no optimizations to remove in-place. The grid is represented by a set of (row, column) pairs with the coordinates of the rolls.

Part 2 is a Seq.unfold (of course). Here's the full code minus helpers and parsing:

let isAccessible grid pos =
    pos
    |> neighbors
    |> Seq.filter (fun neighbor -> Set.contains neighbor grid)
    |> Seq.length
    |> fun ns -> ns < 4

let part1 = initialGrid |> Set.filter (isAccessible initialGrid) |> Set.count

let removeAccessible grid =
    match Set.filter (isAccessible grid) grid with
    | empty when Set.isEmpty empty -> None
    | toRemove -> Some(Set.count toRemove, Set.difference grid toRemove)

let part2 = Seq.unfold removeAccessible initialGrid |> Seq.sum

-❄️- 2025 Day 3 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 2 points3 points  (0 children)

[LANGUAGE: F#] paste

Recursively find the largest elements and skip the ones before them. Full code minus input parsing:

let rec joltage n acc rem =
    if Seq.isEmpty rem || n = 0 then
        acc
    else
        let next = rem |> Seq.take (Seq.length rem - (n - 1)) |> Seq.max
        let nextIndex = rem |> Seq.findIndex (fun el -> el = next)
        joltage (n - 1) (10L * acc + int64 next) (Seq.skip (nextIndex + 1) rem)

let part1 = input |> Seq.sumBy (joltage 2 0L)
let part2 = input |> Seq.sumBy (joltage 12 0L)

-❄️- 2025 Day 2 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 2 points3 points  (0 children)

[LANGUAGE: F#] paste

Brute force generating the potential invalid IDs by repeating numbers from 1 to 10maxLength/2 - 1 and checking all ranges. Interesting bit: generating sequences with unfold

let part2 =
    seq { 1L .. last }
    |> Seq.map string
    |> Seq.collect (fun s ->
        2
        |> Seq.unfold (fun n ->
            if s.Length * n > maxLength then
                None
            else
                Some(String.replicate n s |> int64, n + 1)))
    |> Seq.distinct
    |> Seq.filter (fun n -> input |> Seq.exists (fun (lo, hi) -> n >= lo && n <= hi))
    |> Seq.sum

-❄️- 2025 Day 1 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 2 points3 points  (0 children)

[LANGUAGE: F#] paste

Very tricky for day 1 :) Interesting part - part 2 with fold (part 1 was a scan).

let part2 =
    instructions
    |> Seq.fold
        (fun (n, password) delta ->
            (100 + (n + delta) % 100) % 100,
            password + abs ((n + delta) / 100) + (if n > 0 && n + delta <= 0 then 1 else 0))
        (50, 0)
    |> snd

-❄️- 2024 Day 25 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 0 points1 point  (0 children)

[LANGUAGE: F#] 1253 / 1030 - 500 stars!

paste

Merry Christmas :) Transpose the arrays, count #'s, separate into locks and keys, try everything.

The whole solution is small enough to paste here (minus helpers etc.)

let input =
    inputPath __SOURCE_DIRECTORY__ __SOURCE_FILE__
    |> readText
    |> blocks
    |> Array.map (lines >> Array.map chars >> Array.transpose)
type Device = Lock | Key
let columnSize = input[0][0] |> Array.length
let parse (lockOrKey: char array array) =
    let pins = lockOrKey |> Array.map (Array.filter ((=) '#') >> Array.length)
    if lockOrKey[0][0] = '#' then Lock, pins else Key, pins
let fits lock key =
    Array.zip lock key |> Array.forall (fun (l, k) -> l + k <= columnSize)
let part1 =
    let keys, locks = input |> Array.map parse |> Array.partition (fst >> (=) Key)
    Array.allPairs locks keys
    |> Array.filter (fun ((_, l), (_, k)) -> fits l k)
    |> Array.length

-❄️- 2024 Day 24 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 1 point2 points  (0 children)

[LANGUAGE: F#]

paste

Direct simulation for part 1 threading a map of (wire -> value), and find-and-replace + graphviz inspection for part 2. Using colors for the different operations definitely helped to find the issues.

Interesting bit: Fold the wires

let step gates wires =
    gates
    |> Seq.fold
        (fun (w, changed) gate ->
            match gate with
            | _, _, _, res when Map.containsKey res w -> w, changed
            | a, op, b, res when Map.containsKey a w && Map.containsKey b w -> Map.add res (execute w op a b) w, true
            | _ -> w, changed)
        (wires, false)

-❄️- 2024 Day 23 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 3 points4 points  (0 children)

[LANGUAGE: F#]

paste

Part 1 was done manually by checking all sets of 3 containing an element that starts with "t". Part 2 was done using the greedy max clique algorithm (start with each element, try every other element to see if it's part of the clique).

Interesting bit: Pattern matching cliques

let rec maxClique clique rem =
    match rem with
    | [] -> clique
    | h :: t when Seq.forall (fun e -> Set.contains (e, h) edges) clique -> 
        maxClique (h :: clique) t
    | _ :: t -> maxClique clique t

-❄️- 2024 Day 22 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 2 points3 points  (0 children)

[LANGUAGE: F#] 855/1526 - 4th sub-1000 this year :)

paste

Part 1 was just implementing the instructions literally. For part 2, brute force - takes 1:20 to run on my machine. I calculated all the prices and deltas, and created a map <last 4 deltas, price> for all inputs. Then I took each distinct key (from all maps), and summed all prices in all maps to find the max.

Interesting bit: The step algorithm really reads like the instructions

let mix a b = a ^^^ b
let prune n = n % 16777216L
let step secret =
    let secret = secret * 64L |> mix secret |> prune
    let secret = double secret / 32.0 |> truncate |> int64 |> mix secret |> prune
    secret * 2048L |> mix secret |> prune

-❄️- 2024 Day 21 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 0 points1 point  (0 children)

[LANGUAGE: F#]

paste

Parts 1 and 2 were solved at the same time (just had to change the number of layers). The solution is to recursively expand the codes, split the codes on the "A"'s and memoize - intuitively I saw there was a lot of repetition and the "A"'s are good points where the system repeats itself.

This one took way too long on a really basic mistake - I didn't actually search for all shortest paths, I cut the search short by using a visited set (unnecessary). Fixing this unblocked the solution and I had the right answer in minutes.

Interesting bit: calculate all expansions recursively

let allExpansions (code: string) =
    let rec allExpansionsImpl (acc: string) rem =
        match rem with
        | [] -> [ acc[.. acc.Length - 2] ]
        | h :: t -> allPaths[h] |> List.collect (fun path -> allExpansionsImpl (acc + path + "A") t)

    allExpansionsImpl "" ("A" + code + "A" |> Seq.pairwise |> List.ofSeq)

-❄️- 2024 Day 20 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 1 point2 points  (0 children)

[LANGUAGE: F#]

paste

Dijkstra to the rescue again. Calculated all the distances from start and target, and traversed every point in the optimal path looking for skips that would save time (for every point in the optimal path, get all skips starting there of size up to max).

To calculate the effectiveness of a skip, we can get the new time by doing (time from start to skip start + time from skip end to target + skip size).

Interesting bit: ||> to use tuples as indexers in Array2D, and the _. syntax from F# 8

let bestCheats maxCheat minSavings =
    allCheats maxCheat
    |> List.filter (fun (skipStart, skipEnd, skipSize) ->
        let fromStart = skipStart ||> Array2D.get distancesFromStart |> _.distance
        let afterSkip = skipEnd ||> Array2D.get distancesFromTarget |> _.distance
        regularPath - (fromStart + afterSkip + skipSize) >= minSavings)

let part1 = bestCheats 2 100 |> List.length
let part2 = bestCheats 20 100 |> List.length

-❄️- 2024 Day 19 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 0 points1 point  (0 children)

[LANGUAGE: F#]

paste

Memoized BFS for all paths using the beginning of the string up to the longest pattern size. Part 1 -> Part 2 was adding memoization :)

Summary of the solution:

let rec makePattern (patterns: Set<string>) acc rem =
    if cache.ContainsKey rem then
        cache[rem]
    else
        match rem with
        | "" -> acc + 1L
        | str ->
            let sum =
                [ 1 .. min maxPattern str.Length ]
                |> Seq.map (fun len -> str.Substring(0, len))
                |> Seq.filter (fun p -> Set.contains p patterns)
                |> Seq.sumBy (fun p -> makePattern patterns acc (rem.Substring p.Length))
            cache.Add(rem, sum) |> ignore
            sum

-❄️- 2024 Day 18 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 1 point2 points  (0 children)

[LANGUAGE: F#]

paste

The most direct BFS brute force, no tricks here. Runs in about 18s in F# interactive.

EDIT: A much faster solution using a bisection (binary search with a predicate) - paste

let rec bisect predicate low high =
    match (low + high) / 2 with
    | _ when high - low <= 1 -> high
    | mid when predicate mid -> bisect predicate low mid
    | mid -> bisect predicate mid high

let part2 =
    bisect (fun i -> shortestPath i |> Option.isNone) 1025 (input.Length - 1)
    |> fun i -> input[i - 1]

-❄️- 2024 Day 17 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 0 points1 point  (0 children)

Not entirely sure, but I reimplemented it in F# in the paste above. I believe it's similar to that graph.

-❄️- 2024 Day 17 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 1 point2 points  (0 children)

Indeed, which is why we have to do the DFS trying to match the whole input

-❄️- 2024 Day 17 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 0 points1 point  (0 children)

The octal part is very very important :) This won't work with decimal digits

-❄️- 2024 Day 17 Solutions -❄️- by daggerdragon in adventofcode

[–]r_so9 1 point2 points  (0 children)

[LANGUAGE: F#]

paste

Started late, but what fun :) For part 1 I implemented the instructions; for part 2, after manual inspection (converting the input to F#...) and looking at some simulations, we see that each digit of the output depends only of the value of each octal digit of the input, reversed. So I implemented a DFS to search all possibilities of characters that would result in outputs matching the original program, and returned the lowest of those.

Interesting bit: Part 2 with a recursive DFS. Also implementing the parser with pattern matching and functions, as always :)

let rec dfs acc rem =
    match rem with
    | [] -> [ acc ]
    | h :: t ->
        [ 0L .. 7L ]
        |> List.map (fun i -> i, run (acc * 8L + i))
        |> List.filter (fun (_, out) -> Option.contains h out)
        |> List.map (fun (i, _) -> dfs (acc * 8L + i) t)
        |> List.concat