Haskell

Yay, mutation! Went down the route of caching the expanded lists of stones at first. Oops.

import Data.IORef
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map

blink :: Int -> [Int]
blink 0 = [1]
blink n
  | s <- show n,
    l <- length s,
    even l =
      let (a, b) = splitAt (l `div` 2) s in map read [a, b]
  | otherwise = [n * 2024]

countExpanded :: IORef (Map (Int, Int) Int) -> Int -> [Int] -> IO Int
countExpanded _ 0 = return . length
countExpanded cacheRef steps = fmap sum . mapM go
  where
    go n =
      let key = (n, steps)
          computed = do
            result <- countExpanded cacheRef (steps - 1) $ blink n
            modifyIORef' cacheRef (Map.insert key result)
            return result
       in readIORef cacheRef >>= maybe computed return . (Map.!? key)

main = do
  input <- map read . words <$> readFile "input11"
  cache <- newIORef Map.empty
  mapM_ (\steps -> countExpanded cache steps input >>= print) [25, 75]

C#

public class Day11 : Solver
{
  private long[] data;

  private class TreeNode(TreeNode? left, TreeNode? right, long value) {
    public TreeNode? Left = left;
    public TreeNode? Right = right;
    public long Value = value;
  }

  private Dictionary<(long, int), long> generation_length_cache = [];
  private Dictionary<long, TreeNode> subtree_pointers = [];

  public void Presolve(string input) {
    data = input.Trim().Split(" ").Select(long.Parse).ToArray();
    List<TreeNode> roots = data.Select(value => new TreeNode(null, null, value)).ToList();
    List<TreeNode> last_level = roots;
    subtree_pointers = roots.GroupBy(root => root.Value)
      .ToDictionary(grouping => grouping.Key, grouping => grouping.First());
    for (int i = 0; i < 75; i++) {
      List<TreeNode> next_level = [];
      foreach (var node in last_level) {
        long[] children = Transform(node.Value).ToArray();
        node.Left = new TreeNode(null, null, children[0]);
        if (subtree_pointers.TryAdd(node.Left.Value, node.Left)) {
          next_level.Add(node.Left);
        }
        if (children.Length <= 1) continue;
        node.Right = new TreeNode(null, null, children[1]);
        if (subtree_pointers.TryAdd(node.Right.Value, node.Right)) {
          next_level.Add(node.Right);
        }
      }
      last_level = next_level;
    }
  }

  public string SolveFirst() => data.Select(value => GetGenerationLength(value, 25)).Sum().ToString();
  public string SolveSecond() => data.Select(value => GetGenerationLength(value, 75)).Sum().ToString();

  private long GetGenerationLength(long value, int generation) {
    if (generation == 0) { return 1; }
    if (generation_length_cache.TryGetValue((value, generation), out var result)) return result;
    TreeNode cur = subtree_pointers[value];
    long sum = GetGenerationLength(cur.Left.Value, generation - 1);
    if (cur.Right is not null) {
      sum += GetGenerationLength(cur.Right.Value, generation - 1);
    }
    generation_length_cache[(value, generation)] = sum;
    return sum;
  }

  private IEnumerable<long> Transform(long arg) {
    if (arg == 0) return [1];
    if (arg.ToString() is { Length: var l } str && (l % 2) == 0) {
      return [int.Parse(str[..(l / 2)]), int.Parse(str[(l / 2)..])];
    }
    return [arg * 2024];
  }
}

Haskell

Sometimes I want something mutable, this one takes 0.3s, profiling tells me 30% of my time is spent creating new objects. :/

import Control.Arrow

import Data.Map.Strict (Map)

import qualified Data.Map.Strict as Map
import qualified Data.Maybe as Maybe

type StoneCache = Map Int Int
type BlinkCache = Map Int StoneCache

parse :: String -> [Int]
parse = lines >>> head >>> words >>> map read

memoizedCountSplitStones :: BlinkCache -> Int -> Int -> (Int, BlinkCache)
memoizedCountSplitStones m 0 _ = (1, m)
memoizedCountSplitStones m i n 
        | Maybe.isJust maybeMemoized = (Maybe.fromJust maybeMemoized, m)
        | n == 0     = do
                let (r, rm) = memoizedCountSplitStones m (pred i) (succ n)
                let rm' = cacheWrite rm i n r
                (r, rm')
        | digitCount `mod` 2 == 0 = do
                let (r1, m1) = memoizedCountSplitStones m  (pred i) firstSplit
                let (r2, m2) = memoizedCountSplitStones m1 (pred i) secondSplit
                let m' = cacheWrite m2 i n (r1+r2)
                (r1 + r2, m')
        | otherwise = do
                let (r, m') = memoizedCountSplitStones m (pred i) (n * 2024)
                let m'' = cacheWrite m' i n r
                (r, m'')
        where
                secondSplit    = n `mod` (10 ^ (digitCount `div` 2))
                firstSplit     = (n - secondSplit) `div` (10 ^ (digitCount `div` 2))
                digitCount     = succ . floor . logBase 10 . fromIntegral $ n
                maybeMemoized  = cacheLookup m i n

foldMemoized :: Int -> (Int, BlinkCache) -> Int -> (Int, BlinkCache)
foldMemoized i (r, m) n = (r + r2, m')
        where
                (r2, m') = memoizedCountSplitStones m i n

cacheWrite :: BlinkCache -> Int -> Int -> Int -> BlinkCache
cacheWrite bc i n r = Map.adjust (Map.insert n r) i bc

cacheLookup :: BlinkCache -> Int -> Int -> Maybe Int
cacheLookup bc i n = do
        sc <- bc Map.!? i
        sc Map.!? n

emptyCache :: BlinkCache
emptyCache = Map.fromList [ (i, Map.empty) | i <- [1..75]]

part1 = foldl (foldMemoized 25) (0, emptyCache)
        >>> fst
part2 = foldl (foldMemoized 75) (0, emptyCache)
        >>> fst

main = getContents
        >>= print
        . (part1 &&& part2)
        . parse

And now we get into the days where caching really is king. My first attempt didn’t go so well, I tried to handle the full list result as one cache step, instead of individually caching the result of calculating each stone per step.

I think my original attempt is still calculating at home, but I finished up this much better version on the trip to work.
All hail public transport.

List<long> stones = new List<long>();
public void Input(IEnumerable<string> lines)
{
  stones = string.Concat(lines).Split(' ').Select(v => long.Parse(v)).ToList();
}

public void Part1()
{
  var expanded = TryExpand(stones, 25);

  Console.WriteLine($"Stones: {expanded}");
}
public void Part2()
{
  var expanded = TryExpand(stones, 75);

  Console.WriteLine($"Stones: {expanded}");
}

public long TryExpand(IEnumerable<long> stones, int steps)
{
  if (steps == 0)
    return stones.Count();
  return stones.Select(s => TryExpand(s, steps)).Sum();
}
Dictionary<(long, int), long> cache = new Dictionary<(long, int), long>();
public long TryExpand(long stone, int steps)
{
  var key = (stone, steps);
  if (cache.ContainsKey(key))
    return cache[key];

  var result = TryExpand(Blink(stone), steps - 1);
  cache[key] = result;
  return result;
}

public IEnumerable<long> Blink(long stone)
{
  if (stone == 0)
  {
    yield return 1;
    yield break;
  }
  var str = stone.ToString();
  if (str.Length % 2 == 0)
  {
    yield return long.Parse(str[..(str.Length / 2)]);
    yield return long.Parse(str[(str.Length / 2)..]);
    yield break;
  }
  yield return stone * 2024;
}

Dart

I really wish Dart had memoising built in. Maybe the new macro feature will allow this to happen, but in the meantime, here’s my hand-rolled solution.

import 'package:collection/collection.dart';

var counter_ = <(int, int), int>{};
int counter(s, [r = 75]) => counter_.putIfAbsent((s, r), () => _counter(s, r));
int _counter(int stone, rounds) =>
    (rounds == 0) ? 1 : next(stone).map((e) => counter(e, rounds - 1)).sum;

List<int> next(int s) {
  var ss = s.toString(), sl = ss.length;
  if (s == 0) return [1];
  if (sl.isOdd) return [s * 2024];
  return [ss.substring(0, sl ~/ 2), ss.substring(sl ~/ 2)]
      .map(int.parse)
      .toList();
}

solve(List<String> lines) => lines.first.split(' ').map(int.parse).map(counter).sum;