diff --git a/2024/AOC2024/Day13.hs b/2024/AOC2024/Day13.hs
index 8da37e2..acd6e34 100644
--- a/2024/AOC2024/Day13.hs
+++ b/2024/AOC2024/Day13.hs
@@ -1,6 +1,3 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-
 -- |
 -- Module      : AOC2024.Day13
 -- License     : BSD3
@@ -9,538 +6,57 @@
 -- Portability : non-portable
 --
 -- Day 13.  See "AOC.Solver" for the types used in this module!
---
--- After completing the challenge, it is recommended to:
---
--- *   Replace "AOC.Prelude" imports to specific modules (with explicit
---     imports) for readability.
--- *   Remove the @-Wno-unused-imports@ and @-Wno-unused-top-binds@
---     pragmas.
--- *   Replace the partial type signatures underscores in the solution
---     types @_ :~> _@ with the actual types of inputs and outputs of the
---     solution.  You can delete the type signatures completely and GHC
---     will recommend what should go in place of the underscores.
 module AOC2024.Day13 (
   day13a,
   day13b,
-  getPrize'',
-  testPrize'',
-  solveBezout,
-  restrictRange,
-  runBezout,
-  iterateRange,
-  applyRanges,
-  bezout2D,
-  positive,
-  toLattice,
 )
 where
 
-import AOC.Prelude
-import qualified Data.Graph.Inductive as G
-import qualified Data.IntMap as IM
-import qualified Data.IntMap.NonEmpty as IM
-import qualified Data.IntSet as IS
-import qualified Data.IntSet.NonEmpty as NEIS
-import qualified Data.Interval as IV
-import qualified Data.List.NonEmpty as NE
-import qualified Data.List.PointedList as PL
-import qualified Data.List.PointedList.Circular as PLC
-import qualified Data.Map as M
-import qualified Data.Map.NonEmpty as NEM
-import qualified Data.OrdPSQ as PSQ
-import Data.Proxy
-import qualified Data.Sequence as Seq
-import qualified Data.Sequence.NonEmpty as NESeq
-import qualified Data.Set as S
-import qualified Data.Set.NonEmpty as NES
-import qualified Data.Text as T
-import qualified Data.Vector as V
-import qualified Linear as L
+import AOC.Common (inv22Int)
+import AOC.Common.Parser (pDecimal, parseMaybe', sequenceSepBy)
+import AOC.Common.Point (Point, V2 (..))
+import AOC.Solver (noFail, type (:~>) (..))
+import Control.Monad (guard)
+import Data.Bifunctor (second)
+import Data.Distributive (Distributive (distribute))
+import Data.Maybe (mapMaybe)
+import Linear ((!*))
 import qualified Text.Megaparsec as P
 import qualified Text.Megaparsec.Char as P
-import qualified Text.Megaparsec.Char.Lexer as PP
-import qualified Data.Foldable1 as F1
-
--- Button A: X+53, Y+35
--- Button B: X+11, Y+23
--- Prize: X=13386, Y=18840
-
--- a x + b y = z
--- a x = z - b y
-
-getPrize :: V2 (V2 Int) -> V2 Int -> Maybe Int
-getPrize (V2 a b) g =
-  minimumMay
-    [ na * 3 + nb
-    | na <- [0 .. 100]
-    , nb <- [0 .. 100]
-    , na *^ a + nb *^ b == g
-    ]
-
--- Button A: X+69, Y+48
--- Button B: X+41, Y+88
--- Prize: X=5242, Y=3944
 
-day13a :: _ :~> _
+-- |
+--
+-- [xa xb] [a] = [xc]
+-- [ya yb] [b] = [yc]
+getPrize :: V2 Point -> Point -> Maybe Int
+getPrize coeff targ = do
+  (det, invCoeff) <- inv22Int (distribute coeff)
+  let resDet = invCoeff !* targ
+      V2 a b = (`div` det) <$> resDet
+  guard $ all ((== 0) . (`mod` det)) resDet
+  pure $ 3 * a + b
+
+day13a :: [(V2 Point, Point)] :~> Int
 day13a =
   MkSol
-    { sParse = parseMaybe' $ flip P.sepBy "\n\n" $ do
-        "Button A: X+"
-        x <- pDecimal
-        ", Y+"
-        y <- pDecimal
-        P.newline
-        "Button B: X+"
-        x' <- pDecimal
-        ", Y+"
-        y' <- pDecimal
-        P.newline
-        "Prize: X="
-        x'' <- pDecimal
-        ", Y="
-        y'' <- pDecimal
-        pure (V3 (V2 x y) (V2 x' y') (V2 x'' y''))
+    { sParse = parseMaybe' $ flip P.sepBy "\n\n" do
+        coeff <- traverse parseButton $ V2 "A" "B"
+        "Prize: "
+        p <- sequenceSepBy ((*>) <$> V2 "X=" "Y=" <*> V2 pDecimal pDecimal) ", "
+        pure (coeff, p)
     , sShow = show
     , sSolve =
-        noFail $
-          sum . mapMaybe getPrize''
+        noFail $ sum . mapMaybe (uncurry getPrize)
     }
-
--- a x + b y = z
--- a x = z - b y
--- a = (z - by) / x
-
--- a = z/x - b*y/x
-
-getPrize' :: V2 (V2 Int) -> V2 Int -> Maybe Int
-getPrize' (V2 a@(V2 ax _) b) g =
-  listToMaybe
-    [ na * 3 + nb
-    | nb <- takeWhile zby [0 ..]
-    , let V2 zbx' _ = g - nb *^ b
-    , zbx' `mod` ax == 0
-    , let na = zbx' `div` ax
-    , na *^ a + nb *^ b == g
-    ]
-  where
-    zby nb = all (>= 0) $ g - nb *^ b
-
--- kx - xFactor * r' > 0
--- kx > xFactor * r'
--- r' < kx / xFactor, xFactor > 0
--- r' > kx / xFactor, xFactor < 0
-
--- ky + yFactor * r' > 0
--- yFactor * r' > -ky
--- r' > - kx / yFactor, yFactor > 0
--- r' < - kx / yFactor, yFactor < 0
-
---
-data BezoutSol a = BS
-  { bsA :: V2 a
-  -- ^ m r + b
-  , bsB :: V2 a
-  -- ^ m r + b
-  }
-  deriving stock (Show)
-
--- deriving stock instance Show (f Point) => Show (BezoutSol f)
-
--- solvePositiveBezout :: V3 Int -> Maybe (BezoutSol Identity)
--- solvePositiveBezout (V3 x y z) = do
---   guard $ dm == 0
---   (kx, ky) <- firstJust checkK [0 ..]
---   let xFactor = y `div` d
---       yFactor = x `div` d
---       rxRange
---         | xFactor > 0 = IV.NegInf IV.<=..<= IV.Finite (kx `div` xFactor)
---         | otherwise = IV.Finite (kx `div` xFactor) IV.<=..<= IV.PosInf
---       ryRange
---         | yFactor > 0 = IV.Finite (-(ky `div` yFactor)) IV.<=..<= IV.PosInf
---         | otherwise = IV.NegInf IV.<=..<= IV.Finite (-(ky `div` yFactor))
---       rRange = rxRange `IV.intersection` ryRange
---   (IV.Finite maxR, IV.Closed) <- pure $ IV.lowerBound' rRange
---   (IV.Finite minR, IV.Closed) <- pure $ IV.upperBound' rRange
---   pure
---     BS
---       { bsRange = Identity $ V2 minR maxR
---       , bsA = V2 (-xFactor) kx
---       , bsB = V2 yFactor ky
---       }
---   where
---     d = gcd x y
---     (dd, dm) = z `divMod` d
---     checkK i = [(dd * i, dd * zd) | zm == 0]
---       where
---         (zd, zm) = (d - i * x) `divMod` y
-
--- kx - xFactor * r' > min
--- xFactor * r' < kx - min
--- r' < (kx - min) / xFactor , xFactor > 0
--- r' < (kx - min) / xFactor , xFactor < 0
-
--- ky + yFactor * r' > min
--- yFactor * r' > min - ky
--- r' > (min - ky) / yFactor, yFactor > 0
--- r' < (min - kx) / yFactor, yFactor < 0
-
--- | Range of R such that a/b are within the given interval
-restrictRange :: (Fractional a, Ord a, Integral b) => IV.Interval a -> IV.Interval a -> BezoutSol b -> IV.Interval a
-restrictRange ivA ivB BS{..} = IV.intersections [minA, maxA, minB, maxB]
-  where
-    V2 ma ba = fromIntegral <$> bsA
-    V2 mb bb = fromIntegral <$> bsB
-    (minBoA, minClA) = IV.lowerBound' ivA
-    (maxBoA, maxClA) = IV.upperBound' ivA
-    (minBoB, minClB) = IV.lowerBound' ivB
-    (maxBoB, maxClB) = IV.upperBound' ivB
-    minALim = minBoA <&> \mbo -> (mbo - ba) / ma
-    maxALim = maxBoA <&> \mbo -> (mbo - ba) / ma
-    minBLim = minBoB <&> \mbo -> (mbo - bb) / mb
-    maxBLim = maxBoB <&> \mbo -> (mbo - bb) / mb
-    minA = mkIval (ma > 0) (minALim, minClA)
-    maxA = mkIval (ma < 0) (maxALim, maxClA)
-    minB = mkIval (mb > 0) (minBLim, minClB)
-    maxB = mkIval (mb < 0) (maxBLim, maxClB)
-    mkIval isGT l
-      | isGT = IV.interval (mkNeg `first` l) (IV.PosInf, IV.Open)
-      | otherwise = IV.interval (IV.NegInf, IV.Open) (mkPos `first` l)
-    mkNeg = \case
-      IV.PosInf -> IV.NegInf
-      c -> c
-    mkPos = \case
-      IV.NegInf -> IV.PosInf
-      c -> c
-
--- | Given range of R, give ranges of a/b
-applyRanges :: Integral b => IV.Interval Double -> BezoutSol b -> V2 (IV.Interval Double)
-applyRanges ivR BS{..} =
-  V2 (IV.mapMonotonic (+ ba) $ scaleInterval ma ivR) (IV.mapMonotonic (+ bb) $ scaleInterval mb ivR)
-  where
-    V2 ma ba = fromIntegral <$> bsA
-    V2 mb bb = fromIntegral <$> bsB
-
-scaleInterval :: (Ord a, Num a) => a -> IV.Interval a -> IV.Interval a
-scaleInterval x iv
-  | x > 0 = IV.interval ((* x) <$> minBo, minCl) ((* x) <$> maxBo, maxCl)
-  | otherwise = IV.interval ((* x) <$> flipInf maxBo, maxCl) ((* x) <$> flipInf minBo, minCl)
-  where
-    (minBo, minCl) = IV.lowerBound' iv
-    (maxBo, maxCl) = IV.upperBound' iv
-    flipInf = \case
-      IV.NegInf -> IV.PosInf
-      IV.PosInf -> IV.PosInf
-      IV.Finite q -> IV.Finite q
-
-solveBezout :: Integral a => V3 a -> Maybe (BezoutSol a)
-solveBezout (V3 x y z) = do
-  guard $ dm == 0
-  (kx, ky) <- firstJust checkK [0 ..]
-  let xFactor = y `div` d
-      yFactor = x `div` d
-  pure
-    BS
-      { bsA = V2 (-xFactor) kx
-      , bsB = V2 yFactor ky
-      }
   where
-    d = gcd x y
-    (dd, dm) = z `divMod` d
-    checkK i = [(dd * i, dd * zd) | zm == 0]
-      where
-        (zd, zm) = (d - i * x) `divMod` y
-
-runBezout :: Num a => BezoutSol a -> a  -> V2 a
-runBezout BS{..} r = (\(V2 m b) -> m * r + b) <$> V2 bsA bsB
-
--- okay now we want to find r, r' where
--- m r + b == m' r' + b'
--- m r - m' r' = b' - b
--- lol this becomes a second bezout
-getPrize'' :: V3 (V2 Integer) -> Maybe Integer
-getPrize'' = fmap (F1.maximum . fmap score) . bezout2D (V2 positive positive)
- where
-   score (V2 a b) = 3 * a + b
-  -- V2 cA cB <- solveBezout v
-  -- pure $ cA * 3 + cB
-
-  -- -- bsx: rx -> valid ax/bx/gx solutions
-  -- -- bsy: ry -> valid ay/by/gy solutions
-  -- V2 bsx bsy <- traverse solveBezout . sequenceA $ V3 a b g
-  -- -- rXs: rx giving valid solutions
-  -- -- rYs: ry giving valid solutions
-  -- let rXs = restrictRange positive positive bsx
-  --     rYs = restrictRange positive positive bsy
-  -- guard $ not (IV.null rXs)
-  -- guard $ not (IV.null rYs)
-  -- -- how to generate r's that match for both rx and ry for A
-  -- bsa <-
-  --   solveBezout $
-  --     V3 (view _1 $ bsA bsx) (negate $ view _1 $ bsA bsy) (view _2 (bsA bsy) - view _2 (bsA bsx))
-  -- -- -- how to generate r's that match for both rx and ry for B
-  -- -- bsb <- solveBezout $ V3 (view _1 $ bsB bsx) (negate $ view _1 $ bsB bsy) (view _2 (bsB bsy) - view _2 (bsB bsx))
-  -- rAs <- iterateRange $ restrictRange rXs rYs bsa
-  -- -- rBs <- iterateRange $ restrictRange rXs rYs bsb
-  -- listToMaybe
-  --   [ xa * 3 + xb
-  --   | V2 raA raB <- runBezout bsa <$> rAs
-  --   , -- , V2 rbA rbB <- runBezout bsb <$> rBs
-  --   let x = runBezout bsx raA
-  --       y = runBezout bsy raB
-  --       V2 xa xb = x
-  --       -- , x == y
-  --   ]
-
-positive :: (Num a, Ord a) => IV.Interval a
-positive = 0 IV.<=..< IV.PosInf
-
--- | Nothing: infinite
-widthMaybe :: (Num a, Ord a) => IV.Interval a -> Maybe a
-widthMaybe iv = do
-  IV.Finite _ <- pure $ IV.lowerBound iv
-  IV.Finite _ <- pure $ IV.upperBound iv
-  pure $ IV.width iv
-
--- safeFloor :: a -> Int
--- safeFloor = floor . (+ 1e-10)
-
--- safeCeil :: a -> Int
--- safeCeil = ceiling . subtract 1e-10
-
-toLattice :: RealFrac a => IV.Interval a -> IV.Interval Int
-toLattice iv = IV.interval (ceiling <$> mn, IV.Closed) (floor <$> mx, IV.Closed)
-  where
-    mn = IV.lowerBound iv
-    mx = IV.upperBound iv
-
-singleLattice :: RealFrac a => IV.Interval a -> Maybe Int
-singleLattice iv = do
-  IV.Finite mn <- pure $ ceiling <$> IV.lowerBound iv
-  IV.Finite mx <- pure $ floor <$> IV.upperBound iv
-  guard $ mn == mx
-  pure mn
+    parseButton c = do
+      "Button " *> c *> ": "
+      b <- sequenceSepBy ((*>) <$> V2 "X+" "Y+" <*> V2 pDecimal pDecimal) ", "
+      P.newline
+      pure b
 
-latticeWidth :: RealFrac a => IV.Interval a -> Maybe Int
-latticeWidth iv
-   | IV.null iv = Just 0
-   | otherwise = do
-      IV.Finite mn <- pure $ ceiling <$> IV.lowerBound iv
-      IV.Finite mx <- pure $ floor <$> IV.upperBound iv
-      pure $ mx - mn + 1
-
-bezout2D :: V2 (IV.Interval Rational) -> V3 (V2 Integer) -> Maybe (NonEmpty (V2 Integer))
-bezout2D (V2 ivA ivB) (V3 a b g) = do
-  V2 bsx bsy <- traverse solveBezout . sequenceA $ V3 a b g
-  let rXs = restrictRange ivA ivB bsx
-      rYs = restrictRange ivA ivB bsy
-  -- traceM $ show $ IV.mapMonotonic realToFrac <$> [rXs, rYs]
-  -- traceM $ "widths: " ++ show (latticeWidth <$> [rXs, rYs])
-  -- traceM $ "double widths: " ++ show (fmap realToFrac . widthMaybe <$> [rXs, rYs])
-  -- guard . not $ isNothing (latticeWidth rXs) && isNothing (latticeWidth rYs)
-  -- traceM $ "nulls: " ++ show (IV.null <$> [rXs, rYs])
-  guard . not $ isNothing (mfilter (> 0) $ latticeWidth rXs) && isNothing (mfilter (> 0) $ latticeWidth rYs)
-  -- guard . not $ IV.null rXs && IV.null rYs
-  let feasibles :: Maybe (NonEmpty (V2 Integer))
-      feasibles = do
-        wX <- fromIntegral @Int @Integer <$> latticeWidth rXs
-        wY <- fromIntegral <$> latticeWidth rYs
-        -- traceM $ show (wX, wY)
-        guard $ wX * wY < 10
-        -- traceM $ "good feasibles: " ++ show (wX, wY)
-        sequenceA <$> (V2 <$> (NE.nonEmpty =<< iterateRange rXs) <*> (NE.nonEmpty =<< iterateRange rYs))
-      runWithOption :: NonEmpty (V2 Integer) -> Maybe (NonEmpty (V2 Integer))
-      runWithOption cs = NE.nonEmpty [ resA
-                | V2 resA resB <- toList $ liftA2 runBezout (V2 bsx bsy) <$> cs
-              , resA == resB
-              ]
-  -- traceM $ "feasibles:" ++ show feasibles
-  -- traceM $ show $ realToFrac @_ @Double <$> [IV.width rXs, IV.width rYs]
-  -- traceM $ show [singleLattice rXs, singleLattice rYs]
-  -- Nothing
-  let options =
-        [ runWithOption =<< feasibles
-        , runWithOption =<< bezout2D (V2 rXs rYs) (V3
-            (V2 (view _1 $ bsA bsx) (view _1 $ bsB bsx))
-            (V2 (negate $ view _1 $ bsA bsy) (negate $ view _1 $ bsB bsy))
-            (V2 (view _2 (bsA bsy) - view _2 (bsA bsx)) (view _2 (bsB bsy) - view _2 (bsB bsx))))
-        ]
-  -- fold options
-  asum options
-  -- NE.nonEmpty [ resA
-  --               | V2 resA resB <- toList $ liftA2 runBezout (V2 bsx bsy) <$> coeffs
-  --             , resA == resB
-
-  --             ]
-    -- pullSingle <|> bezout2D (V2 rXs rYs) (V3
-    --       (V2 (view _1 $ bsA bsx) (view _1 $ bsB bsx))
-    --       (V2 (negate $ view _1 $ bsA bsy) (negate $ view _1 $ bsB bsy))
-    --       (V2 (view _2 (bsA bsy) - view _2 (bsA bsx)) (view _2 (bsB bsy) - view _2 (bsB bsx))))
-  -- let V2 resA resB = runBezout <$> V2 bsx bsy <*> coeffs
-  -- guard $ resA == resB
-  -- pure resA
-
--- okay now we want to find r, r' where
--- m r + b == m' r' + b'
--- m r - m' r' = b' - b
--- lol this becomes a second bezout
-testPrize'' :: V3 (V2 Int) -> Maybe _
-testPrize'' (V3 a b g) = Nothing
-
-  ---- bsx: rx -> valid ax/bx/gx solutions
-  ---- bsy: ry -> valid ay/by/gy solutions
-  --V2 bsx bsy <- traverse solveBezout . sequenceA $ V3 a b g
-  ---- at this point we have ways to solve A ax + B bx = gx, A by + B by = gy
-  ---- but we want to know there are any (A,B) pair that would work for both.
-  ----
-  ---- A,B are of the form (ma r + ba, mb r + bb) for both. so if we want them
-  ---- to be equal, we need r where:
-  ----
-  ---- max rA + bax == may rA' + bay
-  ---- => max rA - may rA' == bay - bax
-  ---- mbx rB + bbx == mby rB' + bby
-  ---- => mbx rB - mbx rB' == bby - bbx
-  ----
-  ---- that gives us valid rA/rB's, but that space is still too huge. How do
-  ---- we link it back to the original xyz...
-  ----
-  ---- Ah okay yeah we must remember that each A and B are themselves related.
-  ---- how do we pick (A,B) now considering they work for both?
-  ----
-  ---- what can rA be? well:
-  ----
-  ---- (max rAx + bax) ax + (mbx rBx + bbx) bx = gx
-  ---- (may rAy + bay) ay + (mby rBy + bby) by = gy
-  ----
-  ---- every choice of rAx and rBx within rXs produces a valid 1st eq
-  ---- every choice of rAy and rBy within rXy produces a valid 2st eq
-  ----
-  ---- but rAx rAy cannot vary independently. we can parameterize possible
-  ---- (rAx, rAy) pairs by a variable qA. And same for (rBx rBy) by a variable
-  ---- qB. and then we want to know what ranges qA and qB can take.
-  ----
-  ---- But, even those ranges are way too big, we need some way to intercept
-  ---- them again. I guess if we plub them back in, we can get q to emerge
-  ---- from the big equation.
-  ----
-  ---- Actually wait that's wrong, they have to have the same R across (A,B),
-  ---- so that means our equations are actually:
-  ----
-  ---- (max rX + bax) ax + (mbx rX + bbx) bx = gx
-  ---- (may rY + bay) ay + (mby rY + bby) by = gy
-  ----
-  ---- and of course our A's have to be the same, which means we have:
-  ----
-  ---- max rX + bax == may rY + bay
-  ---- => max rX - may rY = bay - bax
-  ---- mbx rX + bbx == may rY + bby
-  ---- => mab rX - mab rY = bby - bbx
-  ----
-  ---- yeah this is starting to get more constrained. Okay now let's break
-  ---- this down into qA and qB... and see if that helps at all
-  ----
-  ---- max (max' qA + bax') - may (may' qA + bay') = bay - bax
-  ---- mbx (mbx' qB + bbx') - mby (mby' qB + bby') = bby - bbx
-  ----
-  ---- hey it looks like every time we go deeper, the range of values gets
-  ---- smaller. maybe there's something going on here.
-  ----
-  ---- rXs: rx giving valid solutions
-  ---- rYs: ry giving valid solutions
-  --let rXs = restrictRange positive positive bsx
-  --    rYs = restrictRange positive positive bsy
-  --guard $ not (IV.null rXs)
-  --guard $ not (IV.null rYs)
-  ---- how to generate r's that match for both rx and ry for A
-  --bsa <-
-  --  solveBezout $
-  --    V3 (view _1 $ bsA bsx) (negate $ view _1 $ bsA bsy) (view _2 (bsA bsy) - view _2 (bsA bsx))
-  ---- how to generate r's that match for both rx and ry for B
-  --bsb <-
-  --  solveBezout $
-  --    V3 (view _1 $ bsB bsx) (negate $ view _1 $ bsB bsy) (view _2 (bsB bsy) - view _2 (bsB bsx))
-  --let qAs = restrictRange rXs rYs bsa
-  --    qBs = restrictRange rXs rYs bsb
-  --traceM $
-  --  show
-  --    ( rXs
-  --    , rYs
-  --    , V3 (view _1 $ bsA bsx) (negate $ view _1 $ bsA bsy) (view _2 (bsA bsy) - view _2 (bsA bsx))
-  --    , V3 (view _1 $ bsB bsx) (negate $ view _1 $ bsB bsy) (view _2 (bsB bsy) - view _2 (bsB bsx))
-  --    )
-  --bsa' <-
-  --  solveBezout $
-  --    V3 (view _1 $ bsA bsa) (negate $ view _1 $ bsA bsb) (view _2 (bsA bsb) - view _2 (bsA bsa))
-  --bsb' <-
-  --  solveBezout $
-  --    V3 (view _1 $ bsB bsa) (negate $ view _1 $ bsB bsb) (view _2 (bsB bsb) - view _2 (bsB bsa))
-  --let qAs' = restrictRange qAs qBs bsa'
-  --    qBs' = restrictRange qAs qBs bsb'
-  --bsa'' <-
-  --  solveBezout $
-  --    V3 (view _1 $ bsA bsa') (negate $ view _1 $ bsA bsb') (view _2 (bsA bsb') - view _2 (bsA bsa'))
-  --bsb'' <-
-  --  solveBezout $
-  --    V3 (view _1 $ bsB bsa') (negate $ view _1 $ bsB bsb') (view _2 (bsB bsb') - view _2 (bsB bsa'))
-  --let qAs'' = restrictRange qAs' qBs' bsa''
-  --    qBs'' = restrictRange qAs' qBs' bsb''
-  ---- pure $ [ applyRanges rXs bsx, applyRanges rYs bsy ]
-  ---- pure $ [rXs, rYs, rAs, rBs]
-  ---- pure $ IV.mapMonotonic (round @Double @Int) <$> [rXs, rYs, rAs, rBs]
-  ---- pure $ [rXs, rYs, qAs, qBs, qAs', qBs']
-  --pure $ IV.width <$> [rXs, rYs, qAs, qBs, qAs', qBs', qAs'', qBs'']
-
--- minimumMay [ xa * 3 + xb
---      | V2 raA raB <- runBezout bsa <$> rAs
---      -- , V2 rbA rbB <- runBezout bsb <$> rBs
---      , let x = runBezout bsx raA
---            y = runBezout bsy raB
---            V2 xa xb = x
---      , x == y
---      ]
--- listToMaybe [ V2 xa xb
---      | V2 raA raB <- map (runBezout bsa) $ fold $ iterateRange rAs
---      -- , V2 rbA rbB <- runBezout bsb <$> rBs
---      , let x = runBezout bsx raA
---            y = runBezout bsy raB
---            V2 xa xb = x
---      -- , x == y
---      ]
-
--- | Nothing if range is infinite
-iterateRange :: (RealFrac a, Integral b) => IV.Interval a -> Maybe [b]
-iterateRange iv = case (IV.lowerBound' iv, IV.upperBound' iv) of
-  ((IV.Finite mn, _), (IV.Finite mx, _)) -> Just [ceiling mn .. floor mx]
-  _ -> Nothing
-
--- [ (candA *^ a + candB *^ b)
--- \| let dx = gcd ax bx
---       (dxd, dxm) = gx `divMod` dx
--- , dxm == 0
--- , (kax, kbx) <- maybeToList $ firstJust (checkK dx) [0 ..]
--- , rx <- [0 .. 10]
--- , let candA = dxd * kax - ((bx `div` dx) * rx)
---       candB = dxd * kbx + ((ax `div` dx) * rx)
---       -- nb <- takeWhile zby [0 .. ]
---       -- , let V2 zbx' _ = g - nb *^ b
---       -- , zbx' `mod` ax == 0
---       -- , let na = zbx' `div` ax
---       -- , na *^ a + nb *^ b == g
--- ]
--- where
---   checkK dx i = [(i, d) | m == 0]
---     where
---       (d, m) = (dx - i * ax) `divMod` bx
-
---   -- where
---   --   zby nb = all (>= 0) $ g - nb *^ b
-
-day13b :: _ :~> _
+day13b :: [(V2 Point, Point)] :~> Int
 day13b =
-  MkSol
-    { sParse = sParse day13a
-    , sShow = show
-    , sSolve =
-        noFail $
-          sum . mapMaybe (getPrize'' . over _z (10000000000000 +))
+  day13a
+    { sSolve = sSolve day13a . map (second (10000000000000 +))
     }
diff --git a/2024/AOC2024/Day14.hs b/2024/AOC2024/Day14.hs
index 64b5fed..9a81156 100644
--- a/2024/AOC2024/Day14.hs
+++ b/2024/AOC2024/Day14.hs
@@ -17,7 +17,7 @@ import AOC.Common.Parser (pDecimal, parseMaybe', sepByLines, sequenceSepBy)
 import AOC.Common.Point (Point)
 import AOC.Solver (noFail, type (:~>) (..))
 import Control.Lens (view)
-import Control.Monad (join)
+import Control.Monad (join, mfilter)
 import Data.Bifunctor (Bifunctor (second))
 import Data.Foldable1 (foldMap1)
 import qualified Data.List.NonEmpty as NE
@@ -45,14 +45,7 @@ day14a =
   where
     score = product . freqs . mapMaybe quadrant . VS.toList
       where
-        quadrant (V2 x y) = do
-          qx <- classify $ compare x 50
-          qy <- classify $ compare y 51
-          pure (qx, qy)
-        classify = \case
-          LT -> Just False
-          EQ -> Nothing
-          GT -> Just True
+        quadrant p = mfilter (notElem EQ) $ Just (compare <$> p <*> V2 50 51)
 
 day14b :: [V2 Point] :~> Int
 day14b =
diff --git a/2024/AOC2024/Day15.hs b/2024/AOC2024/Day15.hs
index 8a91276..425c8d4 100644
--- a/2024/AOC2024/Day15.hs
+++ b/2024/AOC2024/Day15.hs
@@ -75,8 +75,8 @@ day15b =
           . M.keys
           . M.filter not
           . snd
-          . foldl' (stepper glue walls') (person', crates') $
-          path
+          . foldl' (stepper glue walls') (person', crates')
+          $ path
     }
   where
     doublePoint (V2 x y) = ($ y) <$> [V2 (2 * x), V2 (2 * x + 1)]
@@ -86,11 +86,12 @@ day15b =
       True -> subtract (V2 1 0)
 
 stepper ::
+  forall a.
   (Point -> Dir -> a -> [(Point, a)]) ->
   Set Point ->
-  (V2 Int, Map (V2 Int) a) ->
+  (Point, Map Point a) ->
   Dir ->
-  (V2 Int, Map (V2 Int) a)
+  (Point, Map Point a)
 stepper glue walls (person, crates) d
   | person' `S.member` walls = (person, crates)
   | otherwise = case M.lookup person' crates of
@@ -98,8 +99,10 @@ stepper glue walls (person, crates) d
       Nothing -> (person', crates)
   where
     person' = person + dirPoint d
+    tryMove :: Point -> Map Point a -> a -> Maybe (Map Point a)
     tryMove p crates' moved = do
       foldlM (\cs (p', moved') -> tryMoveSingle p' cs moved') crates' ((p, moved) : glue p d moved)
+    tryMoveSingle :: Point -> Map Point a -> a -> Maybe (Map Point a)
     tryMoveSingle p crates' moved =
       commit
         <$> if p' `S.member` walls
diff --git a/2024/AOC2024/Day16.hs b/2024/AOC2024/Day16.hs
index 6361dde..c3e4c5d 100644
--- a/2024/AOC2024/Day16.hs
+++ b/2024/AOC2024/Day16.hs
@@ -15,7 +15,6 @@ where
 import AOC.Common.Point (Dir (..), Point, dirPoint, parseAsciiMap)
 import AOC.Solver (noFail, type (:~>) (..))
 import Data.Bifunctor (Bifunctor (second))
-import Data.Foldable (Foldable (fold))
 import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Sequence.NonEmpty (NESeq (..))
@@ -50,7 +49,7 @@ day16b =
   MkSol
     { sParse = sParse day16a
     , sShow = show
-    , sSolve = fmap (S.size . fold . snd) . solve
+    , sSolve = fmap (S.size . mconcat . snd) . solve
     }
 
 step :: Set Point -> (Point, Dir) -> Map (Point, Dir) Int
@@ -66,7 +65,7 @@ step walls (p, d) =
   where
     p' = p + dirPoint d
 
-data Path n m p = Path {pCurr :: n, pSeen :: Set m, pCost :: p}
+data Path n m p = Path {pCurr :: !n, pSeen :: !(Set m), pCost :: !p}
   deriving stock (Eq, Ord, Show)
 
 allMinimalPaths ::
diff --git a/2024/AOC2024/Day17.hs b/2024/AOC2024/Day17.hs
index 7264683..a8b97ae 100644
--- a/2024/AOC2024/Day17.hs
+++ b/2024/AOC2024/Day17.hs
@@ -1,6 +1,3 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-
 -- |
 -- Module      : AOC2024.Day17
 -- License     : BSD3
@@ -9,218 +6,159 @@
 -- Portability : non-portable
 --
 -- Day 17.  See "AOC.Solver" for the types used in this module!
---
--- After completing the challenge, it is recommended to:
---
--- *   Replace "AOC.Prelude" imports to specific modules (with explicit
---     imports) for readability.
--- *   Remove the @-Wno-unused-imports@ and @-Wno-unused-top-binds@
---     pragmas.
--- *   Replace the partial type signatures underscores in the solution
---     types @_ :~> _@ with the actual types of inputs and outputs of the
---     solution.  You can delete the type signatures completely and GHC
---     will recommend what should go in place of the underscores.
 module AOC2024.Day17 (
   day17a,
   day17b,
 )
 where
 
-import AOC.Prelude
-import Data.Bits
-import qualified Data.Graph.Inductive as G
-import qualified Data.IntMap as IM
-import qualified Data.IntMap.NonEmpty as IM
-import qualified Data.IntSet as IS
-import qualified Data.IntSet.NonEmpty as NEIS
-import qualified Data.List.NonEmpty as NE
-import qualified Data.List.PointedList as PL
-import qualified Data.List.PointedList.Circular as PLC
-import qualified Data.Map as M
-import qualified Data.Map.NonEmpty as NEM
-import qualified Data.OrdPSQ as PSQ
-import qualified Data.Sequence as Seq
-import qualified Data.Sequence.NonEmpty as NESeq
-import qualified Data.Set as S
-import qualified Data.Set.NonEmpty as NES
-import qualified Data.Text as T
-import qualified Data.Vector as V
-import qualified Linear as L
-import qualified Numeric.Lens as L
-import qualified Text.Megaparsec as P
+import AOC.Common.Parser (pDecimal, parseMaybe', sepBy')
+import AOC.Solver (noFail, type (:~>) (..))
+import Control.Monad (guard)
+import Data.Bits (Bits (shift, xor))
+import Data.Finite (
+  Finite,
+  combineProduct,
+  getFinite,
+  modulo,
+  packFinite,
+  separateProduct,
+  separateSum,
+  strengthen,
+  weakenN,
+ )
+import Data.Foldable (Foldable (toList))
+import Data.List (intercalate)
+import Data.Maybe (listToMaybe)
+import Data.Monoid (Alt (..))
+import Data.Semigroup (Endo (Endo, appEndo))
+import qualified Data.Vector.Sized as SV
 import qualified Text.Megaparsec.Char as P
-import qualified Text.Megaparsec.Char.Lexer as PP
 
-day17a :: _ :~> _
+data Combo
+  = CLiteral (Finite 4)
+  | CReg (Finite 3)
+  deriving stock (Show, Eq, Ord)
+
+data Instr
+  = ADV Combo
+  | BXL (Finite 8)
+  | BST Combo
+  | JNZ (Finite 4)
+  | BXC
+  | OUT Combo
+  | BDV Combo
+  | CDV Combo
+  deriving stock (Show, Eq, Ord)
+
+comboParser :: Finite 7 -> Combo
+comboParser = either CLiteral CReg . separateSum
+
+instrParser :: Finite 8 -> Finite 8 -> Maybe Instr
+instrParser i =
+  SV.fromTuple @_ @8
+    ( fmap (ADV . comboParser) . strengthen
+    , Just . BXL
+    , fmap (BST . comboParser) . strengthen
+    , Just . JNZ . snd . separateProduct @2 @4
+    , const $ Just BXC
+    , fmap (OUT . comboParser) . strengthen
+    , fmap (BDV . comboParser) . strengthen
+    , fmap (CDV . comboParser) . strengthen
+    )
+    `SV.index` i
+
+parseProgram :: [Int] -> Maybe (SV.Vector 8 Instr)
+parseProgram xs = do
+  xsVec <- SV.fromList @16 =<< traverse (packFinite . fromIntegral) xs
+  SV.generateM \i ->
+    instrParser (xsVec `SV.index` combineProduct (0, i)) (xsVec `SV.index` combineProduct (1, i))
+
+day17a :: (Word, Word, Word, SV.Vector 8 Instr, [Finite 8]) :~> [Finite 8]
 day17a =
   MkSol
     { sParse = parseMaybe' do
-        a <- "Register A: " *> pDecimal
-        P.newline
-        b <- "Register B: " *> pDecimal
-        P.newline
-        c <- "Register C: " *> pDecimal
-        P.newline
+        a <- "Register A: " *> pDecimal <* P.newline
+        b <- "Register B: " *> pDecimal <* P.newline
+        c <- "Register C: " *> pDecimal <* P.newline
         P.newline
         d <- "Program: " *> (pDecimal `sepBy'` ",")
-        pure (a, b, c, d)
-    , sShow = intercalate "," . map show
-    , sSolve =
-        noFail $ \(a, b, c, p :: [Int]) ->
-          go 0 (V3 a b c) (Seq.fromList p)
+        p <- case parseProgram d of
+          Nothing -> fail "Bad program"
+          Just p -> pure p
+        pure (a, b, c, p, fromIntegral <$> d)
+    , sShow = intercalate "," . map (show . getFinite)
+    , sSolve = noFail \(a0, b0, c0, instrs, _) ->
+        appEndo (stepWith instrs (Endo . (:)) a0 b0 c0) []
     }
 
-go :: Int -> V3 Int -> Seq Int -> [Int]
--- go i (V3 a b c) tp = case (,) <$> Seq.lookup i tp <*> Seq.lookup (i + 1) tp of
-go i (V3 a b c) tp = case (,) <$> Seq.lookup i tp <*> Seq.lookup (i + 1) tp of
-  Nothing -> []
-  Just (q, o) ->
-    let x = case o of
-          0 -> 0
-          1 -> 1
-          2 -> 2
-          3 -> 3
-          4 -> a
-          5 -> b
-          6 -> c
-     in case q of
-          0 -> go (i + 2) (V3 (a `div` (2 ^ x)) b c) tp
-          1 -> go (i + 2) (V3 a (b `xor` o) c) tp
-          2 -> go (i + 2) (V3 a (x `mod` 8) c) tp
-          3
-            | a == 0 -> go (i + 2) (V3 a b c) tp
-            | otherwise -> go o (V3 a b c) tp
-          4 -> go (i + 2) (V3 a (b `xor` c) c) tp
-          5 -> (x `mod` 8) : go (i + 2) (V3 a b c) tp
-          -- 5 -> trace (show (x `mod` 8, o, x)) (x `mod` 8) : go (i + 2) (V3 a b c) tp
-          6 -> go (i + 2) (V3 a (a `div` (2 ^ x)) c) tp
-          7 -> go (i + 2) (V3 a b (a `div` (2 ^ x))) tp
-
--- 2,4, 1,6, 7,5, 4,6, 1,4, 5,5, 0,3, 3,0
---
--- BST A    --- b = (a `mod` 8)
--- BXL 6    --- b ^= 110    (6)
--- CDV B    --- c = a / (2^b)
--- BXC      --- b ^= c
--- BXL 4    --- b ^= 100    (4)
--- OUT B    --- print b
--- ADV 3    --- a /= 8
--- JNZ 0
-
--- The *`adv`* instruction (opcode *`0`*) performs *division*. The
--- numerator is the value in the `A` register. The denominator is found by
--- raising 2 to the power of the instruction's *combo* operand. (So, an
--- operand of `2` would divide `A` by `4` (`2^2`); an operand of `5` would
--- divide `A` by `2^B`.) The result of the division operation is
-
--- * truncated* to an integer and then written to the `A` register.
-
--- The *`bxl`* instruction (opcode *`1`*) calculates the [bitwise
--- XOR](https://en.wikipedia.org/wiki/Bitwise_operation#XOR){target="_blank"}
--- of register `B` and the instruction's *literal* operand, then stores the
--- result in register `B`.
-
--- The *`bst`* instruction (opcode *`2`*) calculates the value of its
-
--- * combo* operand
-
--- [modulo](https://en.wikipedia.org/wiki/Modulo){target="_blank"} 8
--- (thereby keeping only its lowest 3 bits), then writes that value to the
--- `B` register.
-
--- The *`jnz`* instruction (opcode *`3`*) does *nothing* if the `A`
--- register is `0`. However, if the `A` register is *not zero*, it
--- [*jumps*]{title="The instruction does this using a little trampoline."}
--- by setting the instruction pointer to the value of its *literal*
--- operand; if this instruction jumps, the instruction pointer is *not*
--- increased by `2` after this instruction.
-
--- The *`bxc`* instruction (opcode *`4`*) calculates the *bitwise XOR* of
--- register `B` and register `C`, then stores the result in register `B`.
--- (For legacy reasons, this instruction reads an operand but *ignores*
--- it.)
-
--- The *`out`* instruction (opcode *`5`*) calculates the value of its
-
--- * combo* operand modulo 8, then *outputs* that value. (If a program
-
--- outputs multiple values, they are separated by commas.)
-
--- The *`bdv`* instruction (opcode *`6`*) works exactly like the `adv`
--- instruction except that the result is stored in the *`B` register*. (The
--- numerator is still read from the `A` register.)
-
--- The *`cdv`* instruction (opcode *`7`*) works exactly like the `adv`
--- instruction except that the result is stored in the *`C` register*. (The
--- numerator is still read from the `A` register.)
--- --
-
-day17b :: _ :~> _
+stepWith ::
+  Monoid a =>
+  SV.Vector 8 Instr ->
+  -- | out
+  (Finite 8 -> a) ->
+  -- | Starting a
+  Word ->
+  -- | Starting b
+  Word ->
+  -- | Starting c
+  Word ->
+  a
+stepWith tp out = go 0
+  where
+    go i !a !b !c = case tp `SV.index` i of
+      ADV r -> withStep go (a `div` (2 ^ combo r)) b c
+      BXL l -> withStep go a (b `xor` fromIntegral l) c
+      BST r -> withStep go a (combo r `mod` 8) c
+      JNZ l
+        | a == 0 -> withStep go 0 b c
+        | otherwise -> go (weakenN l) a b c
+      BXC -> withStep go a (b `xor` c) c
+      OUT r ->
+        let o = modulo (fromIntegral (combo r))
+         in out o <> withStep go a b c
+      BDV r -> withStep go a (a `div` (2 ^ combo r)) c
+      CDV r -> withStep go a b (a `div` (2 ^ combo r))
+      where
+        combo = \case
+          CLiteral l -> fromIntegral l
+          CReg 0 -> a
+          CReg 1 -> b
+          CReg _ -> c
+        withStep p
+          | i == maxBound = \_ _ _ -> mempty
+          | otherwise = p (i + 1)
+
+searchStep :: SV.Vector 8 Instr -> [Finite 8] -> [Word]
+searchStep tp outs = do
+  JNZ 0 <- pure $ tp `SV.index` maxBound
+  [CReg _] <- pure [r | OUT r <- toList tp]
+  search 0 (reverse outs)
+  where
+    search a = \case
+      o : os -> do
+        a' <- stepBack a
+        guard $ stepForward a' == Just o
+        search a' os
+      [] -> pure a
+    stepForward :: Word -> Maybe (Finite 8)
+    stepForward a0 = getAlt $ stepWith tp (Alt . Just) a0 0 0
+    stepBack :: Word -> [Word]
+    stepBack = go' maxBound
+      where
+        go' i a = case tp `SV.index` i of
+          ADV r -> do
+            a' <- case r of
+              CLiteral l -> ((a `shift` fromIntegral l) +) <$> [0 .. 2 ^ getFinite l - 1]
+              CReg _ -> []
+            go' (pred i) a'
+          OUT _ -> pure a
+          _ -> go' (pred i) a
+
+day17b :: (Word, Word, Word, SV.Vector 8 Instr, [Finite 8]) :~> Word
 day17b =
   MkSol
     { sParse = sParse day17a
     , sShow = show
-    , sSolve =
-        \(_, _, _, p :: [Int]) -> listToMaybe do
-          option <- stepBackwards (reverse p)
-          guard $ go 0 (V3 option 0 0) (Seq.fromList p) == p
-          pure option
+    , sSolve = \(_, _, _, instrs, o) -> listToMaybe $ searchStep instrs o
     }
-
--- [ (go 0 (V3 i b c) (Seq.fromList p))
--- -- | i <- [45184372088832]
--- \| i <- [1999]
--- ]
-
-stepBackwards :: [Int] -> [Int]
-stepBackwards = search 0
-  where
-    search a = \case
-      [] -> pure a
-      o : os -> do
-        a' <- ((a `shift` 3) +) <$> [0 .. 7]
-        let b0 = (a' .&. 7) `xor` 6
-        let c = a' `shift` (-b0)
-        guard $ ((b0 `xor` c) `xor` 4) .&. 7 == o
-        search a' os
-
--- traceM $ show $ V3 last10A last3B last7C
--- pure ()
-
--- CDV B    --- c = a / (2^b)
--- BXC      --- b ^= c
---
--- c = a / (2^b0)
--- b = b0 ^ c
---
--- b = b0 ^ (a >> b0)
---
--- b = (b0 ^ 110) ^ (a >> (b0 ^ 110))
---
--- b = ((a `mod` 8) ^ 110) ^ (a >> ((a `mod` 8) ^ 110))
---
--- mod 8 is & 111
---
--- b & 111 = ((a & 111) ^ 110) ^ (a >> ((a & 111) ^ 110))
--- b & 111 = ((a ^ 110) & 111) ^ (a >> ((a ^ 110) & 111))
---
--- i guess we can do a search for what (a & 111) is, it's only 7 possible
--- items. But how do we get from that to the full A?
---
--- Ah hah i guess we can store the rest of the A trit-by-trit.
---
---
---
-
--- stepBackwards r@(V3 a b c) = \case
---   [] -> r
---   x:xs ->
-
--- BST A    --- b = (a `mod` 8)
--- BXL 6    --- b ^= 110    (6)
--- CDV B    --- c = a >> b
--- BXC      --- b ^= c
--- BXL 4    --- b ^= 100    (4)
--- OUT B    --- print (b `mod` 8)
--- ADV 3    --- a /= 8
--- JNZ 0
diff --git a/2024/AOC2024/Day19.hs b/2024/AOC2024/Day19.hs
index 95eadd3..531511a 100644
--- a/2024/AOC2024/Day19.hs
+++ b/2024/AOC2024/Day19.hs
@@ -13,59 +13,68 @@ module AOC2024.Day19 (
 where
 
 import AOC.Common.Parser (pAlphaNumWord, parseMaybe')
-import AOC.Solver (type (:~>) (..))
+import AOC.Solver (noFail, type (:~>) (..))
 import Control.DeepSeq (NFData)
-import Control.Monad (guard)
-import Data.Finite (Finite)
-import Data.Foldable (fold)
-import Data.Functor.Foldable (Corecursive (ana), Recursive (cata))
+import Data.Char
+import Data.Foldable (fold, toList)
+import Data.Functor.Foldable hiding (fold)
 import Data.Functor.Foldable.TH (MakeBaseFunctor (makeBaseFunctor))
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IM
+import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe (mapMaybe)
-import Data.Semigroup (Sum (getSum))
-import qualified Data.Vector.Sized as SV
+import Data.Semigroup
+import Data.Set (Set)
+import qualified Data.Set as S
 import GHC.Generics (Generic)
-import GHC.TypeNats (KnownNat)
 import qualified Text.Megaparsec as P
 import qualified Text.Megaparsec.Char as P
 
-data NTrie n a = CT {ctHere :: Maybe a, ctThere :: SV.Vector n (Maybe (NTrie n a))}
+data CharTrie a = CT {ctHere :: Maybe a, ctThere :: IntMap (CharTrie a)}
   deriving stock (Show, Functor, Traversable, Foldable, Generic)
 
-deriving anyclass instance NFData a => NFData (NTrie n a)
+deriving anyclass instance NFData a => NFData (CharTrie a)
 
-makeBaseFunctor ''NTrie
+makeBaseFunctor ''CharTrie
 
-instance Semigroup a => Semigroup (NTrie n a) where
-  CT h1 t1 <> CT h2 t2 = CT (h1 <> h2) (SV.zipWith (<>) t1 t2)
-
-instance (KnownNat n, Semigroup a) => Monoid (NTrie n a) where
-  mempty = CT Nothing (SV.replicate Nothing)
-
-bindTrie :: Semigroup b => NTrie n a -> (a -> NTrie n b) -> NTrie n b
-bindTrie t f = flip cata t \case
-  CTF{..} -> case ctHereF of
-    Nothing -> CT Nothing ctThereF
-    Just x -> case f x of
-      CT here' there' -> CT here' (SV.zipWith (<>) ctThereF there')
-
-singletonTrie :: KnownNat n => [Finite n] -> a -> NTrie n a
-singletonTrie str x = flip ana str \case
-  [] -> CTF (Just x) (SV.replicate Nothing)
-  c : cs -> CTF Nothing (SV.generate \i -> cs <$ guard (i == c))
-
-lookupTrie :: [Finite n] -> NTrie n a -> Maybe a
-lookupTrie str t = cata go t str
+fromMapCoalg ::
+  forall a.
+  (Semigroup a) =>
+  Set [Int] ->
+  Map [Int] a ->
+  CharTrieF a (Map [Int] a)
+fromMapCoalg mp0 = \ks ->
+  let x = M.lookup [] ks
+      reAdd = case x of
+        Nothing -> id
+        Just y -> IM.unionWith (M.unionWith (<>)) (M.fromSet (const y) <$> initialSplit)
+   in CTF x $ reAdd (splitTrie ks)
   where
-    go CTF{..} = \case
-      [] -> ctHereF
-      c : cs -> ($ cs) =<< ctThereF `SV.index` c
+    initialSplit :: IntMap (Set [Int])
+    initialSplit =
+      S.fromDistinctDescList . ($ [])
+        <$> IM.fromAscListWith
+          (.)
+          [ (k, (ks :))
+          | k : ks <- toList mp0
+          ]
+    splitTrie :: Map [Int] a -> IntMap (Map [Int] a)
+    splitTrie mp =
+      M.fromDistinctDescList . ($ [])
+        <$> IM.fromAscListWith
+          (.)
+          [ (k, ((ks, x) :))
+          | (k : ks, x) <- M.toList mp
+          ]
 
-foreverTrie :: (KnownNat n, Semigroup w) => [[Finite n]] -> w -> NTrie n w
-foreverTrie strs x = infiniTrie
-  where
-    tr = foldMap (`singletonTrie` x) strs
-    infiniTrie = singletonTrie [] x <> (tr `bindTrie` const infiniTrie)
+lookupAlg :: CharTrieF a ([Int] -> Maybe a) -> [Int] -> Maybe a
+lookupAlg CTF{..} = \case
+  [] -> ctHereF
+  c : cs -> ($ cs) =<< IM.lookup c ctThereF
+
+buildable :: (Semigroup a) => a -> Set [Int] -> [Int] -> Maybe a
+buildable x0 mp0 = hylo lookupAlg (fromMapCoalg mp0) (M.fromSet (const x0) mp0)
 
 day19 :: Semigroup w => w -> ([w] -> Int) -> ([String], [String]) :~> Int
 day19 x agg =
@@ -78,13 +87,10 @@ day19 x agg =
           ls <- pAlphaNumWord `P.sepBy` P.newline
           pure (ws, ls)
     , sShow = show
-    , sSolve = \(ws, ls) -> do
-        ws' <- traverse toFinites ws
-        ls' <- traverse toFinites ls
-        pure $ agg $ mapMaybe (`lookupTrie` (foreverTrie @5) ws' x) ls'
+    , sSolve = noFail \(ws, ls) ->
+        agg $
+          mapMaybe (buildable x (S.fromList (map ord <$> ws)) . map ord) ls
     }
-  where
-    toFinites = traverse $ flip M.lookup (M.fromList $ zip "wubrg" [0 ..])
 
 day19a :: ([String], [String]) :~> Int
 day19a = day19 () length
diff --git a/2024/AOC2024/Day20.hs b/2024/AOC2024/Day20.hs
index e0ba3aa..129eafa 100644
--- a/2024/AOC2024/Day20.hs
+++ b/2024/AOC2024/Day20.hs
@@ -1,6 +1,3 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-
 -- |
 -- Module      : AOC2024.Day20
 -- License     : BSD3
@@ -9,48 +6,70 @@
 -- Portability : non-portable
 --
 -- Day 20.  See "AOC.Solver" for the types used in this module!
---
--- After completing the challenge, it is recommended to:
---
--- *   Replace "AOC.Prelude" imports to specific modules (with explicit
---     imports) for readability.
--- *   Remove the @-Wno-unused-imports@ and @-Wno-unused-top-binds@
---     pragmas.
--- *   Replace the partial type signatures underscores in the solution
---     types @_ :~> _@ with the actual types of inputs and outputs of the
---     solution.  You can delete the type signatures completely and GHC
---     will recommend what should go in place of the underscores.
 module AOC2024.Day20 (
   day20a,
   day20b,
 )
 where
 
-import AOC.Prelude
-import qualified Data.Graph.Inductive as G
-import qualified Data.IntMap as IM
-import qualified Data.IntMap.NonEmpty as IM
-import qualified Data.IntSet as IS
-import qualified Data.IntSet.NonEmpty as NEIS
-import qualified Data.List.NonEmpty as NE
-import qualified Data.List.PointedList as PL
-import qualified Data.List.PointedList.Circular as PLC
+import AOC.Common (findKeyFor, floodFill)
+import AOC.Common.Point (Point, cardinalNeighbsSet, mannDist, mannNorm, parseAsciiMap)
+import AOC.Solver (noFail, type (:~>) (..))
+import Data.Map (Map)
 import qualified Data.Map as M
-import qualified Data.Map.NonEmpty as NEM
-import qualified Data.OrdPSQ as PSQ
-import qualified Data.Sequence as Seq
-import qualified Data.Sequence.NonEmpty as NESeq
+import Data.Maybe (isNothing)
+import Data.Set (Set)
 import qualified Data.Set as S
-import qualified Data.Set.NonEmpty as NES
-import qualified Data.Text as T
-import qualified Data.Vector as V
-import qualified Linear as L
-import qualified Text.Megaparsec as P
-import qualified Text.Megaparsec.Char as P
-import qualified Text.Megaparsec.Char.Lexer as PP
+import Data.Traversable (mapAccumR)
+import Data.Tuple.Strict (T2 (..))
+
+racePath ::
+  -- | walls
+  Set Point ->
+  -- | start
+  Point ->
+  -- | end
+  Point ->
+  Maybe [Point]
+racePath walls start end = go Nothing start
+  where
+    go :: Maybe Point -> Point -> Maybe [Point]
+    go prev here = do
+      next <- S.lookupMin candidates
+      (here :)
+        <$> if next == end
+          then pure [end]
+          else go (Just here) next
+      where
+        candidates = maybe id S.delete prev $ cardinalNeighbsSet here `S.difference` walls
 
-day20a :: _ :~> _
-day20a =
+findCheats ::
+  -- | walls
+  Set Point ->
+  -- | start
+  Point ->
+  -- | end
+  Point ->
+  -- | cheat length
+  Int ->
+  -- | threshold
+  Int ->
+  Maybe Int
+findCheats walls start end len thresh = do
+  path <- racePath walls start end
+  pure . sum . snd $ mapAccumR go (T2 0 M.empty) path
+  where
+    go :: T2 Int (Map Point Int) -> Point -> (T2 Int (Map Point Int), Int)
+    go (T2 i xs) x =
+      ( T2 (i + 1) (M.insert x i xs)
+      , M.size $
+          M.filterWithKey (\y j -> i - j - mannDist x y >= thresh) $
+            xs `M.restrictKeys` S.mapMonotonic (+ x) diamond
+      )
+    diamond = floodFill (S.filter ((<= len) . mannNorm) . cardinalNeighbsSet) (S.singleton 0)
+
+day20 :: Int -> Map Point (Maybe Bool) :~> Int
+day20 len =
   MkSol
     { sParse =
         noFail $ parseAsciiMap \case
@@ -60,205 +79,14 @@ day20a =
           _ -> Nothing
     , sShow = show
     , sSolve = \mp -> do
-        start : _ <- pure . M.keys $ M.filter (== Just False) mp
-        end : _ <- pure . M.keys $ M.filter (== Just True) mp
-        bb <- boundingBox' $ M.keysSet mp
+        start <- findKeyFor (Just False) mp
+        end <- findKeyFor (Just True) mp
         let walls = M.keysSet $ M.filter isNothing mp
-        goodPath <-
-          let go p = cardinalNeighbsSet p `S.difference` walls
-           in length <$> bfs go start (== end)
-        traceM $ show goodPath
-        let reachable = floodFill (\p -> cardinalNeighbsSet p `S.difference` walls) (S.singleton start)
-            cheats =
-              S.fromList
-                [ (w, d)
-                | w <- toList walls
-                , dir <- [ North ..]
-                , let d = w + dirPoint dir
-                      d' = w - dirPoint dir
-                , d `S.notMember` walls
-                , d' `S.member` reachable
-                -- toList $ cardinalNeighbsSet w `S.difference` walls
-                , inBoundingBox bb d
-                , inBoundingBox bb d'
-                ]
-            cheatPaths = do
-              (w, d) <- toList cheats
-              let go p = cardinalNeighbsSet p `S.difference` S.delete w walls
-                  go' p = cardinalNeighbsSet p `S.difference` walls
-              traceM $ show (w, d)
-              getToCheat <- maybeToList $ length <$> bfs go start (== w)
-              -- getToCheat <- maybeToList $ fst <$> aStar (mannDist w) (M.fromSet (const 1) . go) start (== w)
-              -- guard $ getToCheat + mannDist d end < goodPath - 100
-              -- traceM $ show getToCheat
-              getToEnd <- maybeToList $ (+ 1) . length <$> bfs go' d (== end)
-              -- getToEnd <- maybeToList $ (+1) . fst <$> aStar (mannDist end) (M.fromSet (const 1) . go') d (== end)
-              -- traceM $ show (getToEnd, getToCheat + getToEnd)
-              pure $! getToCheat + getToEnd
-        pure $ countTrue (\t -> traceShowId (goodPath - t) >= 100) cheatPaths
+        findCheats walls start end len 100
     }
 
--- aStar ::
---   forall n p.
---   (Ord n, Ord p, Num p) =>
---   -- | heuristic
---   (n -> p) ->
---   -- | neighborhood
---   (n -> Map n p) ->
---   -- | start
---   n ->
---   -- | target
---   (n -> Bool) ->
---   -- | the shortest path, if it exists, and its cost
---   Maybe (p, [n])
-
-data CheatState = PreCheat
-                | InCheat Int
-                | PostCheat
-  deriving stock (Eq, Ord, Show, Generic)
-  deriving anyclass NFData
-
--- okay new plan:
--- * use spTree from end and spTree from beginning (fgl)
--- * pair up each item in each, that is within range of a "teleport" and would
--- give a good enough time
-day20b :: _ :~> _
-day20b =
-  MkSol
-    { sParse = sParse day20a
-    -- , sShow = unlines . map show
-    , sShow = show
-    -- , sShow = show . length
-    , sSolve = \mp -> do
-        start : _ <- pure . M.keys $ M.filter (== Just False) mp
-        end : _ <- pure . M.keys $ M.filter (== Just True) mp
-        bb <- boundingBox' $ M.keysSet mp
-        let walls = M.keysSet $ M.filter isNothing mp
-            nonWalls = fillBoundingBox bb `S.difference` walls
-            mazeGraph :: G.UGr
-            mazeGraph = G.mkUGraph (zipWith const [0..] $ toList nonWalls)
-              [ (i,j)
-                | (i, p) <- zip [0..] (toList nonWalls)
-              , Just j <- map (`S.lookupIndex` nonWalls) . toList $ cardinalNeighbsSet p `S.difference` walls
-              ]
-            fromStart = M.fromList $ first (`S.elemAt` nonWalls)  <$> G.level (start `S.findIndex` nonWalls) mazeGraph
-            fromEnd = M.fromList $ first (`S.elemAt` nonWalls)  <$> G.level (end `S.findIndex` nonWalls) mazeGraph
-            diamond = floodFill (S.filter ((<= 20) . mannDist 0) . cardinalNeighbsSet) (S.singleton 0)
-        goodPath <-
-          let go p = cardinalNeighbsSet p `S.difference` walls
-           in length <$> bfs go start (== end)
-        pure . sum $ M.toList fromStart <&> \(p, n) ->
-          M.size $ M.filterWithKey (\q m -> n + m + mannDist p q <= goodPath - 100) $ M.restrictKeys fromEnd (S.map (+ p) diamond)
-
-        -- let goCheat (p, st) = S.filter (inBoundingBox bb . fst) $ case st of
-        --       PreCheat -> S.map (, PreCheat) (cardinalNeighbsSet p `S.difference` walls)
-        --                <> S.map (, InCheat 20) (cardinalNeighbsSet p `S.intersection` walls)
-        --       InCheat i
-        --         | i > 2 -> S.map (, InCheat (i - 1)) (cardinalNeighbsSet p)
-        --         | otherwise -> S.map (, PostCheat) (cardinalNeighbsSet p `S.difference` walls)
-        --       PostCheat -> S.map (,PostCheat) (cardinalNeighbsSet p `S.difference` walls)
-        --     cheatIx ps = do
-        --       here <- listToMaybe
-        --         [p
-        --           | (p, InCheat _) <- ps ]
-        --       there <- listToMaybe
-        --         [p
-        --           | (p, PostCheat) <- ps ]
-        --       pure (V2 here there, length ps)
-        --       -- (length xs, length zs)
-        --       --   (xs, ys) = span ((== PreCheat) . snd) ps
-        --       --   zs = dropWhile ((/= PostCheat) . snd) ys
-        --     allPaths = mapMaybe (traceShowId . cheatIx) $ go 0 S.empty (start, PreCheat)
-        --       where
-        --         go n seen s = do
-        --           guard $ n < goodPath - 50
-        --           s'@(p, _) <- toList $ goCheat s
-        --           guard $ p `S.notMember` seen
-        --           (s':) <$> if s' == (end, PostCheat)
-        --              then pure []
-        --              else go (n + 1) (S.insert p seen) s'
-        -- -- pure $
-        -- --   let go p = cardinalNeighbsSet p `S.difference` walls
-        -- --    in bfsAll go start (== end)
-        -- pure . M.toList . M.filter (>= 50) . fmap (goodPath -) $ M.fromListWith min allPaths
-          -- let go (p, st) = S.filter (inBoundingBox bb . fst) $ case st of
-          --       PreCheat -> S.map (, PreCheat) (cardinalNeighbsSet p `S.difference` walls)
-          --                <> S.map (, InCheat 2) (cardinalNeighbsSet p `S.intersection` walls)
-          --       InCheat i
-          --         | i > 2 -> S.map (, InCheat (i - 1)) (cardinalNeighbsSet p)
-          --         | otherwise -> S.map (, PostCheat) (cardinalNeighbsSet p `S.difference` walls)
-          --       PostCheat -> S.map (,PostCheat) (cardinalNeighbsSet p `S.difference` walls)
-          --  in bfsAll go (start, PreCheat) ((== end) . fst)
-        -- traceM $ show goodPath
-        -- let reachable = floodFill (\p -> cardinalNeighbsSet p `S.difference` walls) (S.singleton start)
-        --     cheats =
-        --       S.fromList
-        --         [ (w, d)
-        --         | w <- toList walls
-        --         , dir <- [ North ..]
-        --         , let d = w + dirPoint dir
-        --               d' = w - dirPoint dir
-        --         , d `S.notMember` walls
-        --         , d' `S.member` reachable
-        --         -- toList $ cardinalNeighbsSet w `S.difference` walls
-        --         , inBoundingBox bb d
-        --         , inBoundingBox bb d'
-        --         ]
-        --     cheatPaths = do
-        --       (w, d) <- toList cheats
-        --       let go p = cardinalNeighbsSet p `S.difference` S.delete w walls
-        --           go' p = cardinalNeighbsSet p `S.difference` walls
-        --       traceM $ show (w, d)
-        --       getToCheat <- maybeToList $ length <$> bfs go start (== w)
-        --       -- getToCheat <- maybeToList $ fst <$> aStar (mannDist w) (M.fromSet (const 1) . go) start (== w)
-        --       -- guard $ getToCheat + mannDist d end < goodPath - 100
-        --       -- traceM $ show getToCheat
-        --       getToEnd <- maybeToList $ (+ 1) . length <$> bfs go' d (== end)
-        --       -- getToEnd <- maybeToList $ (+1) . fst <$> aStar (mannDist end) (M.fromSet (const 1) . go') d (== end)
-        --       -- traceM $ show (getToEnd, getToCheat + getToEnd)
-        --       pure $! getToCheat + getToEnd
-        -- pure $ countTrue (\t -> traceShowId (goodPath - t) >= 100) cheatPaths
-    }
-
--- data BFSState n = BS
---   { _bsClosed :: !(Map n (Maybe n))
---   -- ^ map of item to "parent"
---   , _bsOpen :: !(Seq n)
---   -- ^ queue
---   }
-
--- -- | Breadth-first search, with loop detection
--- bfsAll ::
---   forall n.
---   Ord n =>
---   -- | neighborhood
---   (n -> Set n) ->
---   -- | start
---   n ->
---   -- | target
---   (n -> Bool) ->
---   -- | the shortest path, if it exists
---   [[n]]
--- bfsAll ex x0 dest = reconstruct <$> go (addBack x0 Nothing (BS M.empty Seq.empty))
---   where
---     reconstruct :: (n, Map n (Maybe n)) -> [n]
---     reconstruct (goal, mp) = drop 1 . reverse $ goreco goal
---       where
---         goreco n = n : maybe [] goreco (mp M.! n)
---     go :: BFSState n -> [(n, Map n (Maybe n))]
---     go BS{..} = case _bsOpen of
---       Empty -> []
---       n :<| ns
---         | dest n -> (n, _bsClosed) : go (BS _bsClosed ns)
---         | otherwise -> go . S.foldl' (processNeighbor n) (BS _bsClosed ns) $ ex n
---     addBack :: n -> Maybe n -> BFSState n -> BFSState n
---     addBack x up BS{..} =
---       BS
---         { _bsClosed = M.insert x up _bsClosed
---         , _bsOpen = _bsOpen :|> x
---         }
---     processNeighbor :: n -> BFSState n -> n -> BFSState n
---     processNeighbor curr bs0@BS{..} neighb
---       | neighb `M.member` _bsClosed = bs0
---       | otherwise = addBack neighb (Just curr) bs0
+day20a :: Map Point (Maybe Bool) :~> Int
+day20a = day20 2
 
+day20b :: Map Point (Maybe Bool) :~> Int
+day20b = day20 20
diff --git a/2024/AOC2024/Day21.hs b/2024/AOC2024/Day21.hs
index 9029282..0f93d00 100644
--- a/2024/AOC2024/Day21.hs
+++ b/2024/AOC2024/Day21.hs
@@ -1,6 +1,3 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-
 -- |
 -- Module      : AOC2024.Day21
 -- License     : BSD3
@@ -9,65 +6,172 @@
 -- Portability : non-portable
 --
 -- Day 21.  See "AOC.Solver" for the types used in this module!
---
--- After completing the challenge, it is recommended to:
---
--- *   Replace "AOC.Prelude" imports to specific modules (with explicit
---     imports) for readability.
--- *   Remove the @-Wno-unused-imports@ and @-Wno-unused-top-binds@
---     pragmas.
--- *   Replace the partial type signatures underscores in the solution
---     types @_ :~> _@ with the actual types of inputs and outputs of the
---     solution.  You can delete the type signatures completely and GHC
---     will recommend what should go in place of the underscores.
 module AOC2024.Day21 (
--- day21a,
--- day21b
-
+  day21a,
+  day21b,
 )
 where
 
-import AOC.Prelude
+import AOC.Common (digitToIntSafe, (!!!))
+import AOC.Common.Point (Dir (..), Point, V2 (V2), dirPoint)
+import AOC.Solver (noFail, type (:~>) (..))
+import Control.Applicative (liftA3)
+import Control.Monad (mfilter, (<=<))
+import Data.Char (intToDigit, isDigit)
+import Data.Finite (Finite, finites)
+import Data.Functor ((<&>))
 import qualified Data.Graph.Inductive as G
-import qualified Data.IntMap as IM
-import qualified Data.IntMap.NonEmpty as IM
-import qualified Data.IntSet as IS
-import qualified Data.IntSet.NonEmpty as NEIS
-import qualified Data.List.NonEmpty as NE
-import qualified Data.List.PointedList as PL
-import qualified Data.List.PointedList.Circular as PLC
+import Data.Map (Map)
 import qualified Data.Map as M
-import qualified Data.Map.NonEmpty as NEM
-import qualified Data.OrdPSQ as PSQ
-import qualified Data.Sequence as Seq
-import qualified Data.Sequence.NonEmpty as NESeq
-import qualified Data.Set as S
-import qualified Data.Set.NonEmpty as NES
-import qualified Data.Text as T
-import qualified Data.Vector as V
-import qualified Linear as L
-import qualified Text.Megaparsec as P
-import qualified Text.Megaparsec.Char as P
-import qualified Text.Megaparsec.Char.Lexer as PP
-
-day21a :: _ :~> _
-day21a =
-  MkSol
-    { sParse =
-        noFail $
-          lines
-    , sShow = show
-    , sSolve =
-        noFail $
-          id
-    }
+import Data.Maybe (mapMaybe, maybeToList)
+import Data.Tuple (swap)
+
+type NumPad = Maybe (Finite 10)
+type DirPad = Maybe Dir
+
+numPad :: Map Point NumPad
+numPad =
+  M.fromList
+    [ (V2 1 0, Just 0)
+    , (V2 2 0, Nothing)
+    , (V2 0 1, Just 1)
+    , (V2 1 1, Just 2)
+    , (V2 2 1, Just 3)
+    , (V2 0 2, Just 4)
+    , (V2 1 2, Just 5)
+    , (V2 2 2, Just 6)
+    , (V2 0 3, Just 7)
+    , (V2 1 3, Just 8)
+    , (V2 2 3, Just 9)
+    ]
+
+dirPad :: Map Point DirPad
+dirPad =
+  M.fromList
+    [ (V2 0 0, Just West)
+    , (V2 1 0, Just South)
+    , (V2 2 0, Just East)
+    , (V2 1 1, Just North)
+    , (V2 2 1, Nothing)
+    ]
+
+class (Ord a, Show a) => Pushable a where
+  allPushable :: [a]
+  pushMap :: Map (Maybe a) (Map Dir (Maybe a))
+
+allPushable' :: Pushable a => [Maybe a]
+allPushable' = Nothing : fmap Just allPushable
 
-day21b :: _ :~> _
-day21b =
+pushMapFromLayout :: Pushable a => Map Point (Maybe a) -> Map (Maybe a) (Map Dir (Maybe a))
+pushMapFromLayout pushLayout =
+  M.fromList
+    [ (x, M.fromList [(d, y) | d <- [North ..], y <- maybeToList $ M.lookup (p + dirPoint d) pushLayout])
+    | (p, x) <- M.toList pushLayout
+    ]
+
+applyPush :: forall a. Pushable a => Maybe Dir -> Maybe a -> Maybe (Maybe a, Maybe (Maybe a))
+applyPush = \case
+  Nothing -> \x -> Just (x, Just x)
+  Just d -> \x -> do
+    y <- M.lookup d =<< M.lookup x pushMap
+    pure (y, Nothing)
+
+instance Pushable Dir where
+  allPushable = [North ..]
+  pushMap = pushMapFromLayout dirPad
+
+instance Pushable (Finite 10) where
+  allPushable = finites
+  pushMap = pushMapFromLayout numPad
+
+buttonGraph ::
+  forall a.
+  Pushable a =>
+  (G.Gr (Either (Maybe a, DirPad, DirPad) (Maybe a)) DirPad, Map (Maybe a) Int, Map (Maybe a) Int)
+buttonGraph = (G.mkGraph (swap <$> M.toList nodes) edges, startMap, endMap)
+  where
+    nodes :: Map (Either (Maybe a, DirPad, DirPad) (Maybe a)) Int
+    nodes =
+      M.fromList . flip zip [0 ..] $
+        (Left <$> liftA3 (,,) allPushable' allPushable' allPushable')
+          ++ (Right <$> allPushable')
+    startMap = M.fromList [(n, i) | (Left (n, Nothing, Nothing), i) <- M.toList nodes]
+    endMap = M.fromList [(n, i) | (Right n, i) <- M.toList nodes]
+    edges :: [(Int, Int, DirPad)]
+    edges = do
+      (Left (b, d, e), node) <- M.toList nodes
+      push <- reverse allPushable'
+      (e', eout) <- maybeToList $ applyPush push e
+      (d', dout) <- case eout of
+        Nothing -> pure (d, Nothing)
+        Just push' -> maybeToList $ applyPush push' d
+      (b', bout) <- case dout of
+        Nothing -> pure (b, Nothing)
+        Just push' -> maybeToList $ applyPush push' b
+      pure case bout of
+        Nothing -> (node, nodes M.! Left (b', d', e'), push)
+        Just o -> (node, nodes M.! Right o, push)
+
+-- | Best way to get from button to button. penalize motion two bots down
+dirPath :: forall a. Pushable a => Map (Maybe a) (Map (Maybe a) [DirPad])
+dirPath =
+  st <&> \i ->
+    en <&> \j ->
+      runPath Nothing . runPath Nothing . drop 1 . map snd . G.unLPath $ G.lesp i j bg
+  where
+    (bg, st, en) = buttonGraph
+
+dirPathCosts :: Pushable a => Map (Maybe a) (Map (Maybe a) Int)
+dirPathCosts = (fmap . fmap) length dirPath
+
+spellDirPathLengths ::
+  Ord a =>
+  Map (Maybe a) (Map (Maybe a) Int) ->
+  [Maybe a] ->
+  Int
+spellDirPathLengths mp xs = sum $ zipWith (\x y -> (mp M.! x) M.! y) xs (drop 1 xs)
+
+composeDirPathLengths ::
+  Ord b =>
+  Map (Maybe b) (Map (Maybe b) Int) ->
+  Map (Maybe a) (Map (Maybe a) [Maybe b]) ->
+  Map (Maybe a) (Map (Maybe a) Int)
+composeDirPathLengths mp = (fmap . fmap) (spellDirPathLengths mp . (Nothing :))
+
+runPath :: Pushable a => Maybe a -> [DirPad] -> [Maybe a]
+runPath x = \case
+  [] -> []
+  d : ds -> case applyPush d x of
+    Nothing -> error $ "hm..." ++ show d
+    Just (y, out) -> maybe id (:) out $ runPath y ds
+
+dirPathChain :: Int -> Map DirPad (Map DirPad Int)
+dirPathChain n = iterate (`composeDirPathLengths` dirPath @Dir) (dirPathCosts @Dir) !!! n
+
+solveCode :: Int -> [NumPad] -> Int
+solveCode n = spellDirPathLengths mp . (Nothing :)
+  where
+    mp = dirPathChain (n - 1) `composeDirPathLengths` dirPath @(Finite 10)
+
+pc :: Char -> Maybe (Finite 10)
+pc = fmap fromIntegral . digitToIntSafe <=< mfilter isDigit . Just
+
+day21 :: Int -> [[NumPad]] :~> Int
+day21 n =
   MkSol
-    { sParse = sParse day21a
+    { sParse = Just . map (map pc) . lines
     , sShow = show
     , sSolve =
         noFail $
-          id
+          sum . map solve
     }
+  where
+    solve p = num * solveCode n p
+      where
+        num = read (map intToDigit (mapMaybe (fmap fromIntegral) p :: [Int]))
+
+day21a :: [[NumPad]] :~> Int
+day21a = day21 2
+
+day21b :: [[NumPad]] :~> Int
+day21b = day21 25
diff --git a/2024/AOC2024/Day22.hs b/2024/AOC2024/Day22.hs
index 94bf325..3b45a12 100644
--- a/2024/AOC2024/Day22.hs
+++ b/2024/AOC2024/Day22.hs
@@ -1,6 +1,3 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-
 -- |
 -- Module      : AOC2024.Day22
 -- License     : BSD3
@@ -9,65 +6,68 @@
 -- Portability : non-portable
 --
 -- Day 22.  See "AOC.Solver" for the types used in this module!
---
--- After completing the challenge, it is recommended to:
---
--- *   Replace "AOC.Prelude" imports to specific modules (with explicit
---     imports) for readability.
--- *   Remove the @-Wno-unused-imports@ and @-Wno-unused-top-binds@
---     pragmas.
--- *   Replace the partial type signatures underscores in the solution
---     types @_ :~> _@ with the actual types of inputs and outputs of the
---     solution.  You can delete the type signatures completely and GHC
---     will recommend what should go in place of the underscores.
 module AOC2024.Day22 (
--- day22a,
--- day22b
-
+  day22a,
+  day22b,
 )
 where
 
-import AOC.Prelude
-import qualified Data.Graph.Inductive as G
-import qualified Data.IntMap as IM
-import qualified Data.IntMap.NonEmpty as IM
-import qualified Data.IntSet as IS
-import qualified Data.IntSet.NonEmpty as NEIS
-import qualified Data.List.NonEmpty as NE
-import qualified Data.List.PointedList as PL
-import qualified Data.List.PointedList.Circular as PLC
-import qualified Data.Map as M
-import qualified Data.Map.NonEmpty as NEM
-import qualified Data.OrdPSQ as PSQ
-import qualified Data.Sequence as Seq
-import qualified Data.Sequence.NonEmpty as NESeq
-import qualified Data.Set as S
-import qualified Data.Set.NonEmpty as NES
-import qualified Data.Text as T
-import qualified Data.Vector as V
-import qualified Linear as L
-import qualified Text.Megaparsec as P
-import qualified Text.Megaparsec.Char as P
-import qualified Text.Megaparsec.Char.Lexer as PP
+import AOC.Common (strictIterate, (!!!))
+import AOC.Common.Parser (pDecimal, parseMaybe', sepByLines)
+import AOC.Solver (noFail, type (:~>) (..))
+import Control.Monad (unless)
+import Data.Bits (Bits (shift, xor, (.&.)))
+import Data.Foldable (for_)
+import qualified Data.Vector.Storable as VS
+import qualified Data.Vector.Storable.Mutable as MVS
+import Safe.Foldable (maximumMay)
 
-day22a :: _ :~> _
+step :: Int -> Int
+step = prune . phase3 . prune . phase2 . prune . phase1
+  where
+    phase1 n = (n `shift` 6) `xor` n
+    phase2 n = (n `shift` (-5)) `xor` n
+    phase3 n = (n `shift` 11) `xor` n
+    prune = (.&. 16777215)
+
+day22a :: [Int] :~> Int
 day22a =
   MkSol
-    { sParse =
-        noFail $
-          lines
+    { sParse = parseMaybe' $ sepByLines pDecimal
     , sShow = show
-    , sSolve =
-        noFail $
-          id
+    , sSolve = noFail $ sum . map ((!!! 2000) . strictIterate step)
     }
 
-day22b :: _ :~> _
+day22b :: [Int] :~> Int
 day22b =
   MkSol
     { sParse = sParse day22a
     , sShow = show
-    , sSolve =
-        noFail $
-          id
+    , sSolve = \xs -> do
+        let serieses = take 2000 . map (`mod` 10) . strictIterate step <$> xs
+            tots = VS.create do
+              v <- MVS.replicate maxSeq 0
+              for_ serieses \series -> do
+                seens <- MVS.replicate maxSeq False
+                for_ (chompChomp series) \(i, n) -> do
+                  seen <- MVS.exchange seens i True
+                  unless seen $
+                    MVS.modify v (+ n) i
+              pure v
+        maximumMay $ VS.toList tots
     }
+  where
+    maxSeq = encodeSeq [9, 9, 9, 9]
+
+encodeSeq :: [Int] -> Int
+encodeSeq = sum . zipWith (\i x -> x * 19 ^ (i :: Int)) [0 ..] . map (+ 9)
+
+chompChomp :: [Int] -> [(Int, Int)]
+chompChomp (a : b : c : d : e : fs) =
+  (encodeSeq [da, db, dc, dd], e) : chompChomp (b : c : d : e : fs)
+  where
+    da = b - a
+    db = c - b
+    dc = d - c
+    dd = e - d
+chompChomp _ = []
diff --git a/2024/AOC2024/Day23.hs b/2024/AOC2024/Day23.hs
index 70c0130..ba69a91 100644
--- a/2024/AOC2024/Day23.hs
+++ b/2024/AOC2024/Day23.hs
@@ -1,6 +1,3 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-
 -- |
 -- Module      : AOC2024.Day23
 -- License     : BSD3
@@ -9,65 +6,65 @@
 -- Portability : non-portable
 --
 -- Day 23.  See "AOC.Solver" for the types used in this module!
---
--- After completing the challenge, it is recommended to:
---
--- *   Replace "AOC.Prelude" imports to specific modules (with explicit
---     imports) for readability.
--- *   Remove the @-Wno-unused-imports@ and @-Wno-unused-top-binds@
---     pragmas.
--- *   Replace the partial type signatures underscores in the solution
---     types @_ :~> _@ with the actual types of inputs and outputs of the
---     solution.  You can delete the type signatures completely and GHC
---     will recommend what should go in place of the underscores.
 module AOC2024.Day23 (
--- day23a,
--- day23b
-
+  day23a,
+  day23b,
 )
 where
 
-import AOC.Prelude
-import qualified Data.Graph.Inductive as G
-import qualified Data.IntMap as IM
-import qualified Data.IntMap.NonEmpty as IM
-import qualified Data.IntSet as IS
-import qualified Data.IntSet.NonEmpty as NEIS
-import qualified Data.List.NonEmpty as NE
-import qualified Data.List.PointedList as PL
-import qualified Data.List.PointedList.Circular as PLC
+import AOC.Common (countTrue)
+import AOC.Common.Parser (pAlphaNumWord, parseMaybe', sepByLines, sequenceSepBy)
+import AOC.Solver (noFail, type (:~>) (..))
+import Data.Foldable (Foldable (toList))
+import Data.Functor.Foldable (hylo)
+import Data.List (intercalate, isPrefixOf, sort)
+import Data.Map (Map)
 import qualified Data.Map as M
-import qualified Data.Map.NonEmpty as NEM
-import qualified Data.OrdPSQ as PSQ
-import qualified Data.Sequence as Seq
-import qualified Data.Sequence.NonEmpty as NESeq
+import Data.Ord (comparing)
+import Data.Set (Set)
 import qualified Data.Set as S
-import qualified Data.Set.NonEmpty as NES
-import qualified Data.Text as T
-import qualified Data.Vector as V
-import qualified Linear as L
-import qualified Text.Megaparsec as P
-import qualified Text.Megaparsec.Char as P
-import qualified Text.Megaparsec.Char.Lexer as PP
+import GHC.Generics ((:.:) (..))
+import Linear (V2 (..), V3 (..))
+import Safe.Foldable (maximumByMay)
 
-day23a :: _ :~> _
+connMap :: Ord a => [V2 a] -> Map a (Set a)
+connMap xs =
+  M.unionsWith
+    (<>)
+    [ M.fromList [(a, S.singleton b), (b, S.empty)]
+    | [a, b] <- sort . toList <$> xs
+    ]
+
+day23a :: [V2 String] :~> Int
 day23a =
   MkSol
-    { sParse =
-        noFail $
-          lines
+    { sParse = parseMaybe' $ sepByLines $ sequenceSepBy (V2 pAlphaNumWord pAlphaNumWord) "-"
     , sShow = show
     , sSolve =
-        noFail $
-          id
+        noFail \xs ->
+          let conns = connMap xs
+           in countTrue (any ("t" `isPrefixOf`)) do
+                (a, adjA) <- M.toList conns
+                b <- toList adjA
+                c <- toList $ (conns M.! b) `S.intersection` adjA
+                pure (V3 a b c)
     }
 
-day23b :: _ :~> _
+day23b :: [V2 String] :~> [String]
 day23b =
   MkSol
     { sParse = sParse day23a
-    , sShow = show
-    , sSolve =
-        noFail $
-          id
+    , sShow = intercalate ","
+    , sSolve = \xs -> do
+        let conns = connMap xs
+        maximumByMay @[] (comparing length) $
+          hylo @([] :.: (,) String)
+            (foldMap (\(here, there) -> (here :) <$> if null there then pure [] else there) . unComp1)
+            ( fmap \cands ->
+                Comp1
+                  [ (b, cands `S.intersection` (conns M.! b))
+                  | b <- toList cands
+                  ]
+            )
+            (Comp1 $ M.toList conns)
     }
diff --git a/2024/AOC2024/Day24.hs b/2024/AOC2024/Day24.hs
index ad96c3f..e9eb59c 100644
--- a/2024/AOC2024/Day24.hs
+++ b/2024/AOC2024/Day24.hs
@@ -1,6 +1,3 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-
 -- |
 -- Module      : AOC2024.Day24
 -- License     : BSD3
@@ -9,65 +6,178 @@
 -- Portability : non-portable
 --
 -- Day 24.  See "AOC.Solver" for the types used in this module!
---
--- After completing the challenge, it is recommended to:
---
--- *   Replace "AOC.Prelude" imports to specific modules (with explicit
---     imports) for readability.
--- *   Remove the @-Wno-unused-imports@ and @-Wno-unused-top-binds@
---     pragmas.
--- *   Replace the partial type signatures underscores in the solution
---     types @_ :~> _@ with the actual types of inputs and outputs of the
---     solution.  You can delete the type signatures completely and GHC
---     will recommend what should go in place of the underscores.
 module AOC2024.Day24 (
--- day24a,
--- day24b
-
+  day24a,
+  day24b,
 )
 where
 
-import AOC.Prelude
-import qualified Data.Graph.Inductive as G
+import AOC.Common.Parser (CharParser, pAlphaNumWord, parseMaybe', sepByLines, tokenAssoc)
+import AOC.Solver (noFail, type (:~>) (..))
+import Control.DeepSeq (NFData)
+import Control.Monad ((>=>))
+import Control.Monad.Free (Free, MonadFree (wrap), iterA)
+import Control.Monad.State (MonadState (get, put), State, runState)
+import Data.Bifunctor (Bifunctor (second))
+import Data.Either (lefts)
+import Data.Foldable (Foldable (toList))
+import Data.Generics.Labels ()
+import Data.IntMap (IntMap)
 import qualified Data.IntMap as IM
-import qualified Data.IntMap.NonEmpty as IM
-import qualified Data.IntSet as IS
-import qualified Data.IntSet.NonEmpty as NEIS
+import Data.List (intercalate)
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
-import qualified Data.List.PointedList as PL
-import qualified Data.List.PointedList.Circular as PLC
+import Data.Map (Map)
 import qualified Data.Map as M
-import qualified Data.Map.NonEmpty as NEM
-import qualified Data.OrdPSQ as PSQ
-import qualified Data.Sequence as Seq
-import qualified Data.Sequence.NonEmpty as NESeq
-import qualified Data.Set as S
-import qualified Data.Set.NonEmpty as NES
-import qualified Data.Text as T
-import qualified Data.Vector as V
-import qualified Linear as L
+import Data.Maybe (listToMaybe)
+import Data.Tuple (swap)
+import GHC.Generics (Generic)
 import qualified Text.Megaparsec as P
 import qualified Text.Megaparsec.Char as P
-import qualified Text.Megaparsec.Char.Lexer as PP
+import Text.Printf (printf)
+
+data Op = OAnd | OOr | OXor
+  deriving stock (Eq, Ord, Show, Generic)
+  deriving anyclass (NFData)
+
+data Gate a = Gate {gOp :: Op, gX :: a, gY :: a}
+  deriving stock (Show, Generic, Functor, Traversable, Foldable)
+  deriving anyclass (NFData)
+
+normalizeGate :: Ord a => Gate a -> Gate a
+normalizeGate (Gate o x y)
+  | x <= y = Gate o x y
+  | otherwise = Gate o y x
+
+instance Ord a => Eq (Gate a) where
+  a == b = case (normalizeGate a, normalizeGate b) of
+    (Gate o x y, Gate o' x' y') -> o == o' && x == x' && y == y'
+
+instance Ord a => Ord (Gate a) where
+  compare a b = case (normalizeGate a, normalizeGate b) of
+    (Gate o x y, Gate o' x' y') -> mconcat [compare o o', compare x x', compare y y']
+
+parseGate :: CharParser (Gate String)
+parseGate = do
+  gX <- pAlphaNumWord
+  gOp <-
+    P.choice
+      [ OAnd <$ "AND"
+      , OOr <$ "OR"
+      , OXor <$ "XOR"
+      ]
+  gY <- pAlphaNumWord
+  pure Gate{..}
+
+parseInitial :: CharParser (String, Bool)
+parseInitial = (,) <$> P.many P.alphaNumChar <* ": " <*> tokenAssoc [('0', False), ('1', True)]
+
+applyOp :: Op -> Bool -> Bool -> Bool
+applyOp = \case
+  OAnd -> (&&)
+  OOr -> (||)
+  OXor -> (/=)
 
-day24a :: _ :~> _
+applyGate :: Gate Bool -> Bool
+applyGate Gate{..} = applyOp gOp gX gY
+
+day24a :: ([(String, Bool)], [(Gate String, String)]) :~> Int
 day24a =
   MkSol
-    { sParse =
-        noFail $
-          lines
+    { sParse = parseMaybe' do
+        cs <- P.many $ parseInitial <* P.newline
+        P.newline
+        os <- sepByLines $ (,) <$> parseGate <* "-> " <*> P.many P.alphaNumChar
+        pure (cs, os)
     , sShow = show
     , sSolve =
-        noFail $
-          id
+        noFail \(st, xs) ->
+          let rules = M.fromList $ swap <$> xs
+              res = M.fromList st <> (applyGate . fmap (res M.!) <$> rules)
+           in sum [2 ^ read @Int n | ('z' : n, True) <- M.toList res]
     }
 
-day24b :: _ :~> _
+type GateTree = Free Gate
+
+halfAdder :: GateTree a -> GateTree a -> (GateTree a, GateTree a)
+halfAdder x y = (wrap $ Gate OAnd x y, wrap $ Gate OXor x y)
+
+fullAdder :: GateTree a -> GateTree a -> GateTree a -> (GateTree a, GateTree a)
+fullAdder x y carry0 = (wrap $ Gate OOr carry1 carry2, o)
+  where
+    (carry1, z) = halfAdder x y
+    (carry2, o) = halfAdder z carry0
+
+adderTree :: Int -> (GateTree String, NonEmpty (GateTree String))
+adderTree n
+  | n == 0 = (:| []) `second` halfAdder (pure "x00") (pure "y00")
+  | otherwise =
+      let (carryIn, rest) = adderTree (n - 1)
+          (carryOut, new) = fullAdder (pure (printf "x%02d" n)) (pure (printf "y%02d" n)) carryIn
+       in (carryOut, new `NE.cons` rest)
+
+unrollGates ::
+  forall a. Ord a => GateTree a -> State (Int, Map (Gate (Either Int a)) Int) (Either Int a)
+unrollGates = iterA go . fmap Right
+  where
+    go g0 = do
+      gate <- sequenceA g0
+      (currIx, currMp) <- get
+      case M.lookup gate currMp of
+        Nothing -> do
+          put (currIx + 1, M.insert gate currIx currMp)
+          pure $ Left currIx
+        Just i -> pure $ Left i
+
+unrollAdderTree :: Int -> ([Int], IntMap (Gate (Either Int String)))
+unrollAdderTree n = (lefts $ toList outs, IM.fromList $ swap <$> M.toList mp)
+  where
+    (carry, adder) = adderTree n
+    full = NE.reverse $ carry `NE.cons` adder
+    (outs, (_, mp)) = runState (traverse unrollGates full) (0, M.empty)
+
+data NameState = NS
+  { nsRenames :: Map String String
+  , nsNames :: IntMap String
+  , nsFound :: Bool
+  }
+  deriving stock (Generic, Show, Eq, Ord)
+  deriving anyclass (NFData)
+
+nameGate :: Map (Gate String) String -> Int -> Gate (Either Int String) -> NameState -> [NameState]
+nameGate avail ng g0 NS{..} =
+  case applySwaps nsRenames <$> M.lookup gate avail of
+    Nothing -> []
+    Just here ->
+      NS{nsNames = IM.insert ng here nsNames, ..}
+        : [ NS renames (IM.insert ng there nsNames) True
+          | not nsFound
+          , there <- toList avail
+          , here /= there
+          , let renames = M.fromList [(here, there), (there, here)] <> nsRenames
+          ]
+  where
+    gate = either (nsNames IM.!) id <$> g0
+    applySwaps mp x = M.findWithDefault x x mp
+
+nameTree :: Map (Gate String) String -> [Map String String]
+nameTree avail = nsRenames <$> foldr (\o -> (go o >=>)) pure outGates s0
+  where
+    s0 = NS M.empty IM.empty False
+    (outGates, gates) = unrollAdderTree 44
+    go outGate ns0
+      | M.size (nsRenames ns0) == 8 = [ns0]
+      | otherwise =
+          IM.foldrWithKey
+            (\k g -> (nameGate avail k g >=>))
+            pure
+            (IM.takeWhileAntitone (<= outGate) gates)
+            (ns0{nsFound = False})
+
+day24b :: [(Gate String, String)] :~> [String]
 day24b =
   MkSol
-    { sParse = sParse day24a
-    , sShow = show
-    , sSolve =
-        noFail $
-          id
+    { sParse = fmap snd . sParse day24a
+    , sShow = intercalate ","
+    , sSolve = fmap M.keys . listToMaybe . nameTree . M.fromList
     }
diff --git a/2024/AOC2024/Day25.hs b/2024/AOC2024/Day25.hs
index fab2088..2901f45 100644
--- a/2024/AOC2024/Day25.hs
+++ b/2024/AOC2024/Day25.hs
@@ -1,6 +1,3 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-
 -- |
 -- Module      : AOC2024.Day25
 -- License     : BSD3
@@ -9,65 +6,38 @@
 -- Portability : non-portable
 --
 -- Day 25.  See "AOC.Solver" for the types used in this module!
---
--- After completing the challenge, it is recommended to:
---
--- *   Replace "AOC.Prelude" imports to specific modules (with explicit
---     imports) for readability.
--- *   Remove the @-Wno-unused-imports@ and @-Wno-unused-top-binds@
---     pragmas.
--- *   Replace the partial type signatures underscores in the solution
---     types @_ :~> _@ with the actual types of inputs and outputs of the
---     solution.  You can delete the type signatures completely and GHC
---     will recommend what should go in place of the underscores.
 module AOC2024.Day25 (
--- day25a,
--- day25b
-
+  day25a,
 )
 where
 
-import AOC.Prelude
-import qualified Data.Graph.Inductive as G
+import AOC.Common (countTrue, intFreqs, lookupIntFreq)
+import AOC.Common.Point (Point, parseAsciiSet)
+import AOC.Solver (noFail, type (:~>) (..))
+import Control.Lens (view)
+import Data.Foldable (Foldable (toList))
+import Data.IntMap (IntMap)
 import qualified Data.IntMap as IM
-import qualified Data.IntMap.NonEmpty as IM
-import qualified Data.IntSet as IS
-import qualified Data.IntSet.NonEmpty as NEIS
-import qualified Data.List.NonEmpty as NE
-import qualified Data.List.PointedList as PL
-import qualified Data.List.PointedList.Circular as PLC
-import qualified Data.Map as M
-import qualified Data.Map.NonEmpty as NEM
-import qualified Data.OrdPSQ as PSQ
-import qualified Data.Sequence as Seq
-import qualified Data.Sequence.NonEmpty as NESeq
-import qualified Data.Set as S
-import qualified Data.Set.NonEmpty as NES
-import qualified Data.Text as T
-import qualified Data.Vector as V
-import qualified Linear as L
-import qualified Text.Megaparsec as P
-import qualified Text.Megaparsec.Char as P
-import qualified Text.Megaparsec.Char.Lexer as PP
+import Data.List (partition)
+import Data.List.Split (splitOn)
+import Data.Set (Set)
+import Linear.V2 (R1 (_x), R2 (_y))
 
-day25a :: _ :~> _
+day25a :: [Set Point] :~> Int
 day25a =
   MkSol
-    { sParse =
-        noFail $
-          lines
+    { sParse = noFail $ map (parseAsciiSet (== '#')) . splitOn "\n\n"
     , sShow = show
     , sSolve =
         noFail $
-          id
+          uncurry countCombos . partition isLock
     }
+  where
+    isLock = (== 5) . lookupIntFreq 0 . intFreqs . map (view _y) . toList
+    countCombos locks keys = countTrue (all (< 8)) do
+      lock <- colCounts <$> locks
+      key <- colCounts <$> keys
+      pure $ IM.unionWith (+) lock key
 
-day25b :: _ :~> _
-day25b =
-  MkSol
-    { sParse = sParse day25a
-    , sShow = show
-    , sSolve =
-        noFail $
-          id
-    }
+colCounts :: Set Point -> IntMap Int
+colCounts = intFreqs . map (view _x) . toList
diff --git a/advent-of-code.cabal b/advent-of-code.cabal
index 6f41da4..ee15735 100644
--- a/advent-of-code.cabal
+++ b/advent-of-code.cabal
@@ -220,6 +220,8 @@ common solver-deps
     , fin
     , finitary
     , finite-typelits
+    , logict
+    , free
     , foldl
     , free-algebras
     , generic-lens
diff --git a/bench-results/2024/day13.txt b/bench-results/2024/day13.txt
index c243e8f..d00eeac 100644
--- a/bench-results/2024/day13.txt
+++ b/bench-results/2024/day13.txt
@@ -1,18 +1,19 @@
 >> Day 13a
 benchmarking...
-time                 1.887 ms   (1.881 ms .. 1.893 ms)
-                     1.000 R²   (1.000 R² .. 1.000 R²)
-mean                 1.891 ms   (1.887 ms .. 1.898 ms)
-std dev              18.44 μs   (14.30 μs .. 26.49 μs)
+time                 10.70 μs   (10.55 μs .. 10.96 μs)
+                     0.993 R²   (0.987 R² .. 0.997 R²)
+mean                 11.74 μs   (11.23 μs .. 12.34 μs)
+std dev              1.963 μs   (1.546 μs .. 2.237 μs)
+variance introduced by outliers: 95% (severely inflated)
 
 * parsing and formatting times excluded
 
 >> Day 13b
 benchmarking...
-time                 12.28 ms   (12.09 ms .. 12.54 ms)
-                     0.998 R²   (0.996 R² .. 1.000 R²)
-mean                 12.06 ms   (12.00 ms .. 12.22 ms)
-std dev              246.8 μs   (174.1 μs .. 402.2 μs)
+time                 11.78 μs   (11.76 μs .. 11.80 μs)
+                     1.000 R²   (1.000 R² .. 1.000 R²)
+mean                 11.79 μs   (11.77 μs .. 11.81 μs)
+std dev              70.24 ns   (48.18 ns .. 88.93 ns)
 
 * parsing and formatting times excluded
 
diff --git a/bench-results/2024/day16.txt b/bench-results/2024/day16.txt
index 66805d4..0ed9674 100644
--- a/bench-results/2024/day16.txt
+++ b/bench-results/2024/day16.txt
@@ -1,19 +1,19 @@
 >> Day 16a
 benchmarking...
-time                 313.6 ms   (307.1 ms .. 319.8 ms)
-                     1.000 R²   (1.000 R² .. 1.000 R²)
-mean                 314.8 ms   (313.9 ms .. 316.4 ms)
-std dev              1.616 ms   (315.0 μs .. 2.207 ms)
+time                 314.6 ms   (288.1 ms .. 337.2 ms)
+                     0.998 R²   (0.995 R² .. 1.000 R²)
+mean                 322.6 ms   (315.8 ms .. 327.8 ms)
+std dev              7.420 ms   (5.508 ms .. 9.232 ms)
 variance introduced by outliers: 16% (moderately inflated)
 
 * parsing and formatting times excluded
 
 >> Day 16b
 benchmarking...
-time                 322.2 ms   (311.2 ms .. 332.4 ms)
+time                 323.8 ms   (320.3 ms .. 330.2 ms)
                      1.000 R²   (0.999 R² .. 1.000 R²)
-mean                 320.8 ms   (317.9 ms .. 324.1 ms)
-std dev              3.921 ms   (2.314 ms .. 5.846 ms)
+mean                 323.5 ms   (319.1 ms .. 326.7 ms)
+std dev              4.496 ms   (2.480 ms .. 6.795 ms)
 variance introduced by outliers: 16% (moderately inflated)
 
 * parsing and formatting times excluded
diff --git a/bench-results/2024/day19.txt b/bench-results/2024/day19.txt
index 0fb1f97..ca09d6c 100644
--- a/bench-results/2024/day19.txt
+++ b/bench-results/2024/day19.txt
@@ -1,19 +1,19 @@
 >> Day 19a
 benchmarking...
-time                 283.5 ms   (280.3 ms .. 286.0 ms)
-                     1.000 R²   (0.999 R² .. 1.000 R²)
-mean                 294.9 ms   (289.7 ms .. 301.0 ms)
-std dev              7.392 ms   (4.681 ms .. 9.426 ms)
+time                 274.5 ms   (238.8 ms .. 319.5 ms)
+                     0.990 R²   (0.965 R² .. 1.000 R²)
+mean                 291.0 ms   (280.4 ms .. 304.0 ms)
+std dev              15.07 ms   (8.887 ms .. 20.78 ms)
 variance introduced by outliers: 16% (moderately inflated)
 
 * parsing and formatting times excluded
 
 >> Day 19b
 benchmarking...
-time                 280.6 ms   (251.4 ms .. 302.0 ms)
-                     0.997 R²   (0.980 R² .. 1.000 R²)
-mean                 284.8 ms   (277.9 ms .. 289.1 ms)
-std dev              7.324 ms   (1.051 ms .. 10.79 ms)
+time                 263.2 ms   (252.7 ms .. 273.1 ms)
+                     1.000 R²   (0.999 R² .. 1.000 R²)
+mean                 274.3 ms   (268.5 ms .. 285.3 ms)
+std dev              10.64 ms   (1.505 ms .. 14.39 ms)
 variance introduced by outliers: 16% (moderately inflated)
 
 * parsing and formatting times excluded
diff --git a/bench-results/2024/day20.txt b/bench-results/2024/day20.txt
new file mode 100644
index 0000000..d324c82
--- /dev/null
+++ b/bench-results/2024/day20.txt
@@ -0,0 +1,20 @@
+>> Day 20a
+benchmarking...
+time                 34.12 ms   (32.70 ms .. 35.54 ms)
+                     0.994 R²   (0.983 R² .. 1.000 R²)
+mean                 34.98 ms   (34.32 ms .. 36.48 ms)
+std dev              1.880 ms   (715.8 μs .. 3.355 ms)
+variance introduced by outliers: 18% (moderately inflated)
+
+* parsing and formatting times excluded
+
+>> Day 20b
+benchmarking...
+time                 405.5 ms   (393.5 ms .. 431.8 ms)
+                     0.999 R²   (0.999 R² .. 1.000 R²)
+mean                 393.5 ms   (390.1 ms .. 399.7 ms)
+std dev              5.956 ms   (1.238 ms .. 7.831 ms)
+variance introduced by outliers: 19% (moderately inflated)
+
+* parsing and formatting times excluded
+
diff --git a/bench-results/2024/day21.txt b/bench-results/2024/day21.txt
new file mode 100644
index 0000000..8db2ed0
--- /dev/null
+++ b/bench-results/2024/day21.txt
@@ -0,0 +1,19 @@
+>> Day 21a
+benchmarking...
+time                 3.840 μs   (3.834 μs .. 3.851 μs)
+                     1.000 R²   (0.999 R² .. 1.000 R²)
+mean                 3.883 μs   (3.848 μs .. 4.052 μs)
+std dev              222.9 ns   (19.15 ns .. 512.1 ns)
+variance introduced by outliers: 69% (severely inflated)
+
+* parsing and formatting times excluded
+
+>> Day 21b
+benchmarking...
+time                 3.839 μs   (3.831 μs .. 3.849 μs)
+                     1.000 R²   (1.000 R² .. 1.000 R²)
+mean                 3.841 μs   (3.835 μs .. 3.845 μs)
+std dev              16.92 ns   (13.66 ns .. 20.87 ns)
+
+* parsing and formatting times excluded
+
diff --git a/bench-results/2024/day22.txt b/bench-results/2024/day22.txt
new file mode 100644
index 0000000..a04580d
--- /dev/null
+++ b/bench-results/2024/day22.txt
@@ -0,0 +1,19 @@
+>> Day 22a
+benchmarking...
+time                 30.33 ms   (29.99 ms .. 30.67 ms)
+                     0.999 R²   (0.998 R² .. 1.000 R²)
+mean                 30.51 ms   (30.30 ms .. 30.90 ms)
+std dev              550.9 μs   (203.2 μs .. 935.3 μs)
+
+* parsing and formatting times excluded
+
+>> Day 22b
+benchmarking...
+time                 776.3 ms   (767.0 ms .. 784.6 ms)
+                     1.000 R²   (1.000 R² .. 1.000 R²)
+mean                 780.4 ms   (778.0 ms .. 782.1 ms)
+std dev              2.663 ms   (2.009 ms .. 3.144 ms)
+variance introduced by outliers: 19% (moderately inflated)
+
+* parsing and formatting times excluded
+
diff --git a/bench-results/2024/day23.txt b/bench-results/2024/day23.txt
new file mode 100644
index 0000000..4afb533
--- /dev/null
+++ b/bench-results/2024/day23.txt
@@ -0,0 +1,19 @@
+>> Day 23a
+benchmarking...
+time                 3.750 ms   (3.729 ms .. 3.780 ms)
+                     0.998 R²   (0.995 R² .. 1.000 R²)
+mean                 3.789 ms   (3.762 ms .. 3.836 ms)
+std dev              127.3 μs   (65.75 μs .. 221.4 μs)
+variance introduced by outliers: 16% (moderately inflated)
+
+* parsing and formatting times excluded
+
+>> Day 23b
+benchmarking...
+time                 48.57 ms   (48.41 ms .. 48.73 ms)
+                     1.000 R²   (1.000 R² .. 1.000 R²)
+mean                 48.66 ms   (48.57 ms .. 48.78 ms)
+std dev              200.5 μs   (137.2 μs .. 264.3 μs)
+
+* parsing and formatting times excluded
+
diff --git a/bench-results/2024/day24.txt b/bench-results/2024/day24.txt
new file mode 100644
index 0000000..1a2cbc3
--- /dev/null
+++ b/bench-results/2024/day24.txt
@@ -0,0 +1,20 @@
+>> Day 24a
+benchmarking...
+time                 104.0 μs   (103.9 μs .. 104.2 μs)
+                     1.000 R²   (1.000 R² .. 1.000 R²)
+mean                 104.9 μs   (104.5 μs .. 106.1 μs)
+std dev              2.157 μs   (1.014 μs .. 4.014 μs)
+variance introduced by outliers: 16% (moderately inflated)
+
+* parsing and formatting times excluded
+
+>> Day 24b
+benchmarking...
+time                 1.569 ms   (1.554 ms .. 1.604 ms)
+                     0.997 R²   (0.991 R² .. 1.000 R²)
+mean                 1.550 ms   (1.542 ms .. 1.572 ms)
+std dev              46.62 μs   (11.57 μs .. 87.93 μs)
+variance introduced by outliers: 17% (moderately inflated)
+
+* parsing and formatting times excluded
+
diff --git a/bench-results/2024/day25.txt b/bench-results/2024/day25.txt
new file mode 100644
index 0000000..7ad450e
--- /dev/null
+++ b/bench-results/2024/day25.txt
@@ -0,0 +1,10 @@
+>> Day 25a
+benchmarking...
+time                 6.789 ms   (6.668 ms .. 6.890 ms)
+                     0.990 R²   (0.973 R² .. 1.000 R²)
+mean                 6.953 ms   (6.849 ms .. 7.262 ms)
+std dev              552.1 μs   (61.43 μs .. 1.049 ms)
+variance introduced by outliers: 46% (moderately inflated)
+
+* parsing and formatting times excluded
+
diff --git a/common/AOC/Common.hs b/common/AOC/Common.hs
index 7b4cbfc..3440704 100644
--- a/common/AOC/Common.hs
+++ b/common/AOC/Common.hs
@@ -47,6 +47,7 @@ module AOC.Common (
   fixedPoint,
   floodFill,
   floodFillCount,
+  floodFillSteps,
   countTrue,
   pickUnique,
   maybeAlt,
@@ -119,13 +120,9 @@ module AOC.Common (
   caeser,
   eitherItem,
   chooseEither,
-  toNatural,
-  factorial,
-  integerFactorial,
-  pascals,
-  triangles,
-  triangleNumber,
   mapMaybeSet,
+  findKeyFor,
+  flipMap,
   symDiff,
   unfoldedIterate,
   memo4,
@@ -136,6 +133,18 @@ module AOC.Common (
   unListDigits,
   _DigitList,
 
+  -- * Integers
+  egcd,
+  modInverse,
+  bezout,
+  inv22Int,
+  toNatural,
+  factorial,
+  integerFactorial,
+  pascals,
+  triangles,
+  triangleNumber,
+
   -- * Comonad stuff
   matchMap,
   storeMapNeighborhood,
@@ -211,7 +220,7 @@ import qualified Data.Vector.Unboxed.Mutable.Sized as UVM
 import Data.Word
 import Debug.Trace
 import GHC.TypeNats
-import Linear (Additive (..), R1 (..), R2 (..), R3 (..), R4 (..), V2 (..), V3 (..), V4 (..))
+import Linear (Additive (..), R1 (..), R2 (..), R3 (..), R4 (..), V2 (..), V3 (..), V4 (..), det22, M22)
 import qualified Numeric.Lens as L
 import Safe
 
@@ -303,6 +312,9 @@ scanrT f z = snd . mapAccumR (\x -> dup . flip f x) z
 firstRepeated :: Ord a => [a] -> Maybe a
 firstRepeated = firstRepeatedBy id
 
+findKeyFor :: Eq a => a -> Map k a -> Maybe k
+findKeyFor x = listToMaybe . M.keys . M.filter (== x)
+
 -- | Lazily find the first repeated projection.
 firstRepeatedBy :: Ord a => (b -> a) -> [b] -> Maybe b
 firstRepeatedBy f = go S.empty
@@ -429,6 +441,9 @@ revFreq =
     . M.toList
     . freqs
 
+flipMap :: (Ord k, Ord a) => Map k a -> Map a (Set k)
+flipMap = M.fromListWith (<>) . map (\(k, v) -> (v, S.singleton k)) . M.toList
+
 bindFreq :: Ord b => Map a Int -> (a -> Map b Int) -> Map b Int
 bindFreq mp f = M.unionsWith (+) [(* n) <$> f x | (x, n) <- M.toList mp]
 
@@ -841,6 +856,24 @@ floodFillCount f = go 0 S.empty
         innr' = S.union innr outr
         outr' = foldMap f outr `S.difference` innr'
 
+-- | Flood fill from a starting set, with the shortest distance
+floodFillSteps ::
+  Ord a =>
+  -- | Expansion (be sure to limit allowed points)
+  (a -> Set a) ->
+  -- | Start points
+  Set a ->
+  -- | Flood filled, with count of number of steps
+  Map a Int
+floodFillSteps f = go 0 M.empty
+  where
+    go !n !innr !outr
+      | S.null outr' = innr'
+      | otherwise = go (n + 1) innr' outr'
+      where
+        innr' = innr <> M.fromSet (const n) outr
+        outr' = foldMap f outr `S.difference` M.keysSet innr'
+
 type Graph v e = Map v (Map v e)
 
 toFGL :: (G.Graph gr, Ord v) => Graph v e -> (gr v e, Set v)
@@ -1012,6 +1045,70 @@ factorial n = go 2 1
       | i > n = x
       | otherwise = go (i + 1) (x * i)
 
+-- | case egcd a b of
+--      (d, u, v) ->
+--          u * a + v * b = d
+--       && d == gcd(a,b)
+--
+-- from arithmoi library
+egcd :: Integral a => a -> a -> (a, a, a)
+egcd a b = (d, u, v)
+  where
+    (d, x, y) = eGCD 0 1 1 0 (abs a) (abs b)
+    u
+      | a < 0 = negate x
+      | otherwise = x
+    v
+      | b < 0 = negate y
+      | otherwise = y
+    eGCD !n1 o1 !n2 o2 r s
+      | s == 0 = (r, o1, o2)
+      | otherwise = case r `quotRem` s of
+          (q, t) -> eGCD (o1 - q * n1) n1 (o2 - q * n2) n2 s t
+{-# SPECIALIZE egcd ::
+  Int -> Int -> (Int, Int, Int)
+  , Word -> Word -> (Word, Word, Word)
+  , Integer -> Integer -> (Integer, Integer, Integer)
+  #-}
+
+-- | modInverse(a,b) is (a^-1 in Z_b, b^-1 in Z_a)
+modInverse :: Integral a => a -> a -> Maybe (a, a)
+modInverse x y = case egcd x y of
+  (1, u, v) -> Just (u, v)
+  _ -> Nothing
+
+-- | gives (V2 (V2 mx bx) (V2 my by)), where x solutions are (mx k + bx) and y
+-- solutions are (my k + by)
+bezout :: Integral a => a -> a -> a -> Maybe (V2 (V2 a))
+bezout a b c
+  | r == 0 =
+      Just $
+        V2
+          (V2 (b `div` d) (u * c'))
+          (V2 (- (a `div` d)) (v * c'))
+  | otherwise = Nothing
+  where
+    (d, u, v) = egcd a b
+    (c', r) = c `divMod` d
+{-# SPECIALIZE bezout ::
+  Int -> Int -> Int -> Maybe (V2 (V2 Int)),
+  Word -> Word -> Word -> Maybe (V2 (V2 Word)),
+  Integer -> Integer -> Integer -> Maybe (V2 (V2 Integer))
+  #-}
+
+-- | Returns det(A) and inv(A)det(A)
+inv22Int :: (Num a, Eq a) => M22 a -> Maybe (a, M22 a)
+inv22Int m@(V2 (V2 a b) (V2 c d))
+  | det == 0 = Nothing
+  | otherwise = Just (det, V2 (V2 d (-b)) (V2 (-c) a))
+  where
+    det = det22 m
+{-# SPECIALIZE inv22Int ::
+   M22 Int -> Maybe (Int, M22 Int),
+   M22 Word -> Maybe (Word, M22 Word),
+   M22 Integer -> Maybe (Integer, M22 Integer)
+  #-}
+
 integerFactorial :: Integer -> Integer
 integerFactorial n = go 2 1
   where
diff --git a/common/AOC/Common/Point.hs b/common/AOC/Common/Point.hs
index fc7ae20..4bf67cb 100644
--- a/common/AOC/Common/Point.hs
+++ b/common/AOC/Common/Point.hs
@@ -320,8 +320,6 @@ centeredFinite =
     (subtract d . (% 1) . getFinite)
     (Finite . numerator . (+ d))
   where
-    -- Finite . numerator . (+ d) <$> f ((getFinite i % 1) - d)
-
     d = fromIntegral (natVal (Proxy @n) - 1) % 2
 
 parseDir :: Char -> Maybe Dir
diff --git a/common/AOC/Common/Search.hs b/common/AOC/Common/Search.hs
index 0f0b485..25a9220 100644
--- a/common/AOC/Common/Search.hs
+++ b/common/AOC/Common/Search.hs
@@ -1,6 +1,7 @@
 module AOC.Common.Search (
   aStar,
   bfs,
+  bfsActions,
   binarySearch,
   exponentialSearch,
   binaryMinSearch,
@@ -19,6 +20,7 @@ import Data.Sequence (Seq (..))
 import qualified Data.Sequence as Seq
 import Data.Set (Set)
 import qualified Data.Set as S
+import Data.List (foldl')
 
 data AStarState n p = AS
   { _asClosed :: !(Map n (Maybe n))
@@ -64,8 +66,6 @@ aStar h ex x0 dest = second reconstruct <$> go (addBack x0 0 Nothing (AS M.empty
       | neighb `M.member` _asClosed = as0
       | otherwise = addBack neighb (currCost + moveCost) (Just curr) as0
 
--- addBack neighb (currCost + moveCost) (Just curr) as0
-
 insertIfBetter :: (Ord k, Ord p) => k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
 insertIfBetter k p x q = case Q.lookup k q of
   Nothing -> Q.insert k p x q
@@ -115,56 +115,49 @@ bfs ex x0 dest = reconstruct <$> go (addBack x0 Nothing (BS M.empty Seq.empty))
       | neighb `M.member` _bsClosed = bs0
       | otherwise = addBack neighb (Just curr) bs0
 
--- -- | Breadth-first search, with loop detection, stopping at first result
--- bfs :: forall n. Ord n
---     => (n -> Set n)   -- ^ neighborhood
---     -> n              -- ^ start
---     -> (n -> Bool)    -- ^ target
---     -> Maybe [n]      -- ^ the shortest path, if it exists
--- bfs ex x0 dest = fmap snd . M.lookupMin $ bfsAll ex x0 (mfilter dest . Just) ((> 0) . S.size)
-
--- data BFSState n a = BS { _bsClosed  :: !(Map n (Maybe n))  -- ^ map of item to "parent"
---                        , _bsOpen    :: !(Seq n          )  -- ^ queue
---                        , _bsFound   :: !(Map a n        )  -- ^ found items
---                        }
+data BFSActionState a n = BAS
+  { _basClosed :: !(Map n (Maybe (a, n)))
+  -- ^ map of item to "parent"
+  , _basOpen :: !(Seq n)
+  -- ^ queue
+  }
 
--- -- | Breadth-first search, with loop detection, to find all matches.
--- bfsAll :: forall n a. (Ord n, Ord a)
---     => (n -> Set n)             -- ^ neighborhood
---     -> n                        -- ^ start
---     -> (n -> Maybe a)              -- ^ keep me when True
---     -> (Set a -> Bool)          -- ^ stop when True
---     -> Map a [n]
--- bfsAll ex x0 isGood stopper = reconstruct <$> founds
--- -- M.fromSet reconstruct founds
---   where
---     (founds, parentMap) = go . addBack x0 Nothing $ BS M.empty Seq.empty M.empty
---     reconstruct :: n -> [n]
---     reconstruct goal = drop 1 . reverse $ goreco goal
---       where
---         goreco n = n : maybe [] goreco (parentMap M.! n)
---     go :: BFSState n a -> (Map a n, Map n (Maybe n))
---     go BS{..} = case _bsOpen of
---       Empty    -> (_bsFound, _bsClosed)
---       (!n) :<| ns ->
---         let (found', updated) = case isGood n of
---               Just x
---                 | x `M.notMember` _bsFound -> (M.insert x n _bsFound, True)
---               _   -> (_bsFound, False)
---             stopHere = updated && stopper (M.keysSet found')
---         in  if stopHere
---               then (found', _bsClosed)
---               else go . S.foldl' (processNeighbor n) (BS _bsClosed ns found') $ ex n
---     addBack :: n -> Maybe n -> BFSState n a -> BFSState n a
---     addBack !x !up BS{..} = BS
---       { _bsClosed = M.insert x up _bsClosed
---       , _bsOpen   = _bsOpen :|> x
---       , _bsFound  = _bsFound
---       }
---     processNeighbor :: n -> BFSState n a -> n -> BFSState n a
---     processNeighbor !curr bs0@BS{..} neighb
---       | neighb `M.member` _bsClosed = bs0
---       | otherwise                   = addBack neighb (Just curr) bs0
+-- | Breadth-first search, with loop detection, that outputs actions
+bfsActions ::
+  forall a n.
+  Ord n =>
+  -- | neighborhood
+  (n -> [(a, n)]) ->
+  -- | start
+  n ->
+  -- | target
+  (n -> Bool) ->
+  -- | the shortest path, if it exists
+  Maybe [a]
+bfsActions ex x0 dest = reconstruct <$> go (addBack x0 Nothing (BAS M.empty Seq.empty))
+  where
+    reconstruct :: (n, Map n (Maybe (a, n))) -> [a]
+    reconstruct (goal, mp) = reverse $ goreco goal
+      where
+        goreco n = case mp M.! n of
+          Nothing -> []
+          Just (act, n') -> act : goreco n'
+    go :: BFSActionState a n -> Maybe (n, Map n (Maybe (a, n)))
+    go BAS{..} = case _basOpen of
+      Empty -> Nothing
+      n :<| ns
+        | dest n -> Just (n, _basClosed)
+        | otherwise -> go . foldl' (processNeighbor n) (BAS _basClosed ns) $ ex n
+    addBack :: n -> Maybe (a, n) -> BFSActionState a n -> BFSActionState a n
+    addBack x up BAS{..} =
+      BAS
+        { _basClosed = M.insert x up _basClosed
+        , _basOpen = _basOpen :|> x
+        }
+    processNeighbor :: n -> BFSActionState a n -> (a, n) -> BFSActionState a n
+    processNeighbor curr bs0@BAS{..} (act,neighb)
+      | neighb `M.member` _basClosed = bs0
+      | otherwise = addBack neighb (Just (act, curr)) bs0
 
 binarySearch ::
   (Int -> Ordering) -> -- LT: Too small, GT: Too big
diff --git a/reflections/2024/day13.md b/reflections/2024/day13.md
new file mode 100644
index 0000000..af0ff61
--- /dev/null
+++ b/reflections/2024/day13.md
@@ -0,0 +1,55 @@
+This one reduces to basically solving two linear equations, but it's kind of
+fun to see what the *linear* haskell library gives us to make things more
+convenient.
+
+Basically for `xa`, `ya`, `xb`, `yb`, we want to solve the matrix equation `M p
+= c` for `p`, where `c` is our target `<x, y>`, and `M` is `[ xa xb; ya yb ]`.  We're
+going to assume that our two buttons are linearly independent (they are not
+multiples of each other).  Note that the `M` matrix is the transpose of the
+numbers as we originally parse them.
+
+Normally we can solve this as `p = M^-1 C`, where `M^-1 = [ yb -xb; -ya xa] /
+(ad - bc)`. However, we only care about integer solutions. This means that we
+can do some checks:
+
+1.  Compute `det = ad - bc` and a matrix `U = [yb -xb ; -ya xa]`, which is
+    `M^-1 * det`.
+2.  Compute `p*det = U c`
+3.  Check that `det` is not 0
+4.  Check that ``(`mod` det)`` is 0 for all items in `U c`
+5.  Our result is then the ``(`div` det)`` for all items in `U c`.
+
+*linear* has the `det22` method for the determinant of a 2x2 matrix, but it
+doesn't quite have the `M^-1 * det` function, it only has `M^-1` for
+`Fractional` instances.  So we can write our own:
+
+```haskell
+-- | Returns det(A) and inv(A)det(A)
+inv22Int :: (Num a, Eq a) => M22 a -> Maybe (a, M22 a)
+inv22Int m@(V2 (V2 a b) (V2 c d))
+  | det == 0 = Nothing
+  | otherwise = Just (det, V2 (V2 d (-b)) (V2 (-c) a))
+  where
+    det = det22 m
+
+type Point = V2 Int
+
+getPrize :: V2 Point -> Point -> Maybe Int
+getPrize coeff targ = do
+  (det, invTimesDet) <- inv22Int (transpose coeff)
+  let resTimesDet = invTimesDet !* targ
+      V2 a b = (`div` det) <$> resTimesDet
+  guard $ all ((== 0) . (`mod` det)) resTimesDet
+  pure $ 3 * a + b
+
+part1 :: [(V2 Point, Point)] -> Int
+part1 = sum . mapMaybe (uncurry getPrize)
+
+part2 :: [(V2 Point, Point)] -> Int
+part2 = part2 . map (second (10000000000000 +))
+```
+
+Here we take advantage of `transpose`, `det22`, `!*` for matrix-vector
+multiplication, the `Functor` instance of vectors for `<$>`, the `Foldable`
+instance of vectors for `all`, and the `Num` instance of vectors for numeric
+literals and `+`.
diff --git a/reflections/2024/day14.md b/reflections/2024/day14.md
new file mode 100644
index 0000000..aad9c2d
--- /dev/null
+++ b/reflections/2024/day14.md
@@ -0,0 +1,50 @@
+Problems like this showcase the utility of using `V2` from *linear* for keeping
+track of points. The "step" function ends up pretty clean:
+
+```haskell
+type Point = V2 Int
+
+step :: Point -> Point -> Point
+step v x = mod <$> (x + v) <*> V2 101 103
+```
+
+Also, if we parse into `[V2 Point]` (a position and velocity paired up in a
+`V2`) we can use `sequence` to unzip our list into a `V2 [Point] [Point]`, a
+list of positions and velocities. We can then use `iterate` and `zipWith` to
+step them:
+
+```haskell
+part1 :: [V2 Point] -> Int
+part2 pvs = score $ iterate (zipWith step vs) ps !! 100
+  where
+    V2 ps vs = sequence pvs
+    score = product . M.fromListWith (+) . mapMaybe (\p -> (classify p, 1))
+    quadrant p = mfilter (notElem EQ) $ Just (compare <$> p <*> V2 50 51)
+```
+
+`quadrant` here uses the `Applicative` instance and also the `Foldable`
+instance with `notElem`.
+
+For my original solve of part 2, i stopped when I detected any large clusters.
+But, once we see that the actual input consists of vertical and horizontal
+lines, we can do a bit of optimizations. We know that the x positions have a
+period of 101, and so frames with vertical lines appear with period 101.  We
+know that y positions have a period of 103 and so frames with horizontal lines
+appear with period 103. So, we can look at the first 101 frames and find any
+vertical lines, and then the first 103 frames and find any horizontal lines,
+and then do some math to figure out when the periodic appearances will line up.
+
+```haskell
+maxMargin :: [[Int]] -> Int
+maxMargin = fst . maximumBy (comparing (concentration . snd)) . zip [0..]
+  where
+    concentration = product . M.fromListWith (+) . map (,1)
+
+part1 :: [V2 Point] -> Int
+part2 pvs = (xi + ((yi - xi) * 5151)) `mod` 10403
+  where
+    V2 ps vs = sequence pvs
+    steps = iterate (zipWith step vs) ps
+    xi = maxMargin (view _x <$> take 101 steps)
+    yi = maxMargin (view _y <$> take 103 steps)
+```
diff --git a/reflections/2024/day15.md b/reflections/2024/day15.md
new file mode 100644
index 0000000..ea71c76
--- /dev/null
+++ b/reflections/2024/day15.md
@@ -0,0 +1,96 @@
+This is puzzle involves iteratively following "steps" and seeing how things
+change.  If we store the world state polymorphically as a `Map Point a`, then
+we can write something generic to unite both parts.
+
+Our polymorphic stepper will take a:
+
+1.  `Set Point` of immovable walls
+2.  A "glue" function `Point -> Dir -> a -> [(Point, a)]` which takes an `a`
+    world entity and return any other entity it will be glued to.
+2.  A starting state `(Point, Map Point a)`, the player position and the
+    position of the crates
+3.  A `Dir` motion
+
+and return the new updated `(Point, Map Point a)` state.
+
+It will work by first trying to update the person state: if it moves into a
+crate, try to move the crate in the same direction, `Point -> Map Point a -> a
+-> Maybe (Map Point a)`. This will then recursively try to move any crates
+along the way and any crates glued to it. The whole thing is wrapped up in a
+big `Maybe` monad, sequenced together with `foldlM`, so if anything fails, the
+whole thing fails. This is essentially a recursion-based DFS.
+
+```haskell
+type Point = V2 Int
+data Dir = North | East | South | West
+
+moveByDir :: Point -> Dir -> Point
+moveByDir p d = p + case d of
+  North -> V2 0 1
+  East -> V2 1 0
+  South -> V2 0 (-1)
+  West -> V2 (-1) 1
+
+stepper ::
+  forall a.
+  (Point -> Dir -> a -> [(Point, a)]) ->
+  Set Point ->
+  (Point, Map Point a) ->
+  Dir ->
+  (Point, Map Point a)
+stepper glue walls (person, crates) d
+  | person' `S.member` walls = (person, crates)
+  | otherwise = case M.lookup person' crates of
+      Just lr -> maybe (person, crates) (person',) $ tryMove person' crates lr
+      Nothing -> (person', crates)
+  where
+    person' = person `moveByDir` d
+    tryMove :: Point -> Map Point a -> a -> Maybe (Map Point a)
+    tryMove p crates' moved = do
+      foldlM (\cs (p', moved') -> tryMoveSingle p' cs moved') crates' ((p, moved) : glue p d moved)
+    tryMoveSingle :: Point -> Map Point a -> a -> Maybe (Map Point a)
+    tryMoveSingle p crates' moved =
+      commit
+        <$> if p' `S.member` walls
+          then Nothing
+          else case M.lookup p' crates' of
+            Just lr -> tryMove p' crates' lr
+            Nothing -> Just crates'
+      where
+        p' = p `moveByDir` d
+        commit = M.delete p . M.insert p' moved
+```
+
+Now to pick the glue and the `a`: for part 1, each crate contains no extra
+information, so `a` will be `()` and `glue _ _ _ = []`, no glue.
+
+```haskell
+part1 :: Set Point -> Set Point -> Point -> [Dir] -> Set Point
+part1 crates walls person =
+    M.keys . snd . foldl' (stepper glue crates) (person, M.fromSet (const ()) walls)
+  where
+    glue _ _ _ = []
+```
+
+For part 2, each crate is either a `[` or a `]`, left or right. So we can have
+the `a` be `Bool`, and the glue being the corresponding pair, but only if the
+motion direction is vertical.
+
+```haskell
+part2 :: Set Point -> Map Point Bool -> Point -> [Dir] -> Set Point
+part2 crates walls person =
+    M.keys . snd . foldl' (stepper glue crates) (person, walls)
+  where
+    glue p d lr = [(bump lr p, not lr) | d `elem` [North, South]]
+    bump = \case
+      False -> (+ V2 1 0)
+      True -> subtract (V2 1 0)
+```
+
+We can score our set of points:
+
+```haskell
+score :: Set Point -> Int
+score = sum . map (\(V2 x y) -> 100 * y + x) . toList 
+```
+
diff --git a/reflections/2024/day16.md b/reflections/2024/day16.md
new file mode 100644
index 0000000..fe4333e
--- /dev/null
+++ b/reflections/2024/day16.md
@@ -0,0 +1,111 @@
+Nothing too deep I could think of for this one other than a specialized
+dijkstra BFS, that initially acts like normal dijkstra until the first
+successful path is found: after that, it treats that as the best cost, and it
+only re-adds points back to the queue if the cost is less than the known best
+cost.
+
+```haskell
+data Path n p = Path {pCurr :: n, pSeen :: Set n, pCost :: p}
+  deriving stock (Eq, Ord, Show)
+
+allMinimalPaths ::
+  forall n p.
+  (Ord n, Ord p, Num p) =>
+  -- | neighborhood
+  (n -> Map n p) ->
+  -- | start
+  n ->
+  -- | target
+  (n -> Bool) ->
+  -- | all paths with the shortest cost
+  Maybe (p, [Set n])
+allMinimalPaths expand start targ = go0 (M.singleton start path0) (M.singleton 0 (NESeq.singleton path0))
+  where
+    path0 = Path start S.empty 0
+    go0 :: Map n (Path n p) -> Map p (NESeq (Path n p)) -> Maybe (p, [Set n])
+    go0 bests queue = do
+      ((p, Path{..} NESeq.:<|| xs), queue') <- M.minViewWithKey queue
+      let queue'' = case NESeq.nonEmptySeq xs of
+            Nothing -> queue'
+            Just xs' -> M.insert p xs' queue'
+      if targ pCurr
+        then Just (p, pSeen : go1 p bests (M.takeWhileAntitone (<= p) queue''))
+        else
+          uncurry go0 . M.foldlWithKey' (processNeighbor pCost pSeen) (bests, queue'') $ expand pCurr
+    go1 :: p -> Map n (Path n p) -> Map p (NESeq (Path n m p)) -> [Set n]
+    go1 minCost bests queue = case M.minViewWithKey queue of
+      Nothing -> []
+      Just ((p, Path{..} NESeq.:<|| xs), queue') ->
+        let queue'' = case NESeq.nonEmptySeq xs of
+              Nothing -> queue'
+              Just xs' -> M.insert p xs' queue'
+         in if targ pCurr
+              then pSeen : go1 minCost bests queue''
+              else
+                uncurry (go1 minCost)
+                  . second (M.takeWhileAntitone (<= minCost))
+                  . M.foldlWithKey' (processNeighbor pCost pSeen) (bests, queue'')
+                  $ expand pCurr
+    processNeighbor ::
+      p ->
+      Set n ->
+      (Map n (Path n p), Map p (NESeq (Path n p))) ->
+      n ->
+      p ->
+      (Map n (Path n p), Map p (NESeq (Path n p)))
+    processNeighbor cost seen (bests, queue) x newCost
+      | x `S.member` seen = (bests, queue)
+      | otherwise = case M.lookup x bests of
+          Nothing -> (M.insert x newPath bests, newQueue)
+          Just Path{..}
+            | cost + newCost <= pCost -> (M.insert x newPath bests, newQueue)
+            | otherwise -> (bests, queue)
+      where
+        newPath = Path x (S.insert x seen) (cost + newCost)
+        newQueue =
+          M.insertWith
+            (flip (<>))
+            (cost + newCost)
+            (NESeq.singleton newPath)
+            queue
+```
+
+Then we can solve part 1 and part 2 with the same search:
+
+```haskell
+type Point = V2 Int
+
+type Dir = Finite 4
+
+dirPoint :: Dir -> Point
+dirPoint = SV.index $ SV.fromTuple (V2 0 (-1), V2 1 0, V2 0 1, V2 (-1) 0)
+
+step :: Set Point -> (Point, Dir) -> Map (Point, Dir) Int
+step walls (p, d) =
+  M.fromList
+    [ ((p, d'), 1000)
+    | d' <- [d + 1, d - 1]
+    , (p + dirPoint d') `S.notMember` walls
+    ]
+    <> if p' `S.member` walls
+      then mempty
+      else M.singleton (p', d) 1
+  where
+    p' = p + dirPoint d
+
+solve :: Set Point -> Point -> Point -> Maybe (Int, [Set Point])
+solve walls start end = 
+  second (map (S.map fst)) <$> allMinimalPaths proj (step walls) (start, East) ((== end) . fst)
+
+part1 :: Set Point -> Point -> Point -> Maybe Int
+part1 walls start end = fst <$> solve walls start end
+
+part2 :: Set Point -> Point -> Point -> Maybe Int
+part2 walls start end = S.size mconcat . snd <$> solve walls start end
+```
+
+Right now we consider two nodes to be the same if they have the same position
+and the same direction, but there's a slight optimization we can do if we
+consider them to be the same if they are in the same position and on the same
+axis (going north/south vs going east/west) since it closes off paths that
+backtrack.  However in practice this isn't really a big savings (5% for me).
diff --git a/reflections/2024/day17.md b/reflections/2024/day17.md
new file mode 100644
index 0000000..79c0449
--- /dev/null
+++ b/reflections/2024/day17.md
@@ -0,0 +1,135 @@
+This one is a cute little interpreter problem, a staple of advent of code.
+Let's write Part 1 in a way that makes Part 2 easy, where we will have to
+eventually "run" it backwards. We can use `Finite n` as the type with `n`
+inhabitants, so `Finite 8` will, for example, have the numbers 0 to 7. And also
+`Vector n a` from `Data.Vector.Sized`, which contains `n` items.
+
+```haskell
+data Combo
+  = CLiteral (Finite 4)
+  | CReg (Finite 3)
+
+data Instr
+  = ADV Combo
+  | BXL (Finite 8)
+  | BST Combo
+  | JNZ (Finite 4)
+  | BXC
+  | OUT Combo
+  | BDV Combo
+  | CDV Combo
+```
+
+We can then write a function to interpret the outputs into a monoid.
+
+```haskell
+stepWith ::
+  Monoid a =>
+  Vector 8 Instr ->
+  -- | out
+  (Finite 8 -> a) ->
+  -- | Starting a
+  Word ->
+  -- | Starting b
+  Word ->
+  -- | Starting c
+  Word ->
+  a
+stepWith prog out = go 0
+  where
+    go i !a !b !c = case prog `SV.index` i of
+      ADV r -> withStep go (a `div` (2 ^ combo r)) b c
+      BXL l -> withStep go a (b `xor` fromIntegral l) c
+      BST r -> withStep go a (combo r `mod` 8) c
+      JNZ l
+        | a == 0 -> withStep go 0 b c
+        | otherwise -> go (weakenN l) a b c   -- weakenN :: Finite 4 -> Finite 8
+      BXC -> withStep go a (b `xor` c) c
+      OUT r ->
+        let o = modulo (fromIntegral (combo r))
+         in out o <> withStep go a b c
+      BDV r -> withStep go a (a `div` (2 ^ combo r)) c
+      CDV r -> withStep go a b (a `div` (2 ^ combo r))
+      where
+        combo = \case
+          CLiteral l -> fromIntegral l
+          CReg 0 -> a
+          CReg 1 -> b
+          CReg _ -> c
+        withStep p
+          | i == maxBound = \_ _ _ -> mempty
+          | otherwise = p (i + 1)
+```
+
+Part 1 is a straightforward application, although we can use a difflist to get
+O(n) concats instead of O(n^2)
+
+```haskell
+import Data.DList as DL
+
+part1 :: Vector 8 Instr -> Word -> Word -> Word -> [Finite 8]
+part1 prog a b c = DL.toList $ stepWith prog DL.singleton a b c
+```
+
+Part 2 it gets a bit interesting. We can solve it "in general" under the
+conditions:
+
+
+1.  The final instruction is JNZ 0
+2.  There is one `OUT` per loop, with a register
+3.  b and c are overwritten at the start of each loop
+
+The plan would be:
+
+
+1.  Start from the end with a known `a` and move backwards, accumulating all
+    possible values of `a` that would lead to the end value, ignoring b and c
+2.  For each of those possible a's, start from the beginning with that `a` and
+    filter the ones that don't produce the correct `OUT`.
+
+We have to write a "step backwards" from scratch, but we can actually use our
+original `stepWith` to write a version that _bails_ after the first output, by
+having our monoid be `Data.Monoid.First`. Then in the line `out o <> withStep
+go a abc`, it'll just completely ignore the right hand side and output the
+first `OUT` result.
+
+```haskell
+searchStep :: Vector 8 Instr -> [Finite 8] -> [Word]
+searchStep prog outs = do
+  -- enforce the invariants
+  JNZ 0 <- pure $ prog `SV.index` maxBound
+  [CReg _] <- pure [r | OUT r <- toList prog]
+  search 0 (reverse outs)
+  where
+    search a = \case
+      o : os -> do
+        a' <- stepBack a
+        guard $ stepForward a' == Just o
+        search a' os
+      [] -> pure a
+    -- doesn't enforce that b and c are reset, because i'm lazy
+    stepForward :: Word -> Maybe (Finite 8)
+    stepForward a0 = getFirst $ stepWith tp (First . Just) a0 0 0
+    stepBack :: Word -> [Word]
+    stepBack = go' maxBound
+      where
+        go' i a = case tp `SV.index` i of
+          ADV r -> do
+            a' <- case r of
+              CLiteral l -> ((a `shift` fromIntegral l) +) <$> [0 .. 2 ^ getFinite l - 1]
+              CReg _ -> []
+            go' (pred i) a'
+          OUT _ -> pure a
+          _ -> go' (pred i) a
+```
+
+We really only have to handle the `ADV r` case because that's the only
+instruction that modifies `A`. If we `ADV 3`, that means that the possible
+"starting A's" are `known_a * 8 + x`, where `x` is between 0 and 7.
+
+Wrapping it all up:
+
+```haskell
+part2 :: Vector 8 Instr -> [Finite 8] -> Maybe Word
+part2 instrs = listToMaybe . searchStep instrs
+```
diff --git a/reflections/2024/day18.md b/reflections/2024/day18.md
new file mode 100644
index 0000000..c77f35f
--- /dev/null
+++ b/reflections/2024/day18.md
@@ -0,0 +1,90 @@
+Honestly there really isn't much to this puzzle other than applying a basic BFS
+to solve the maze. It isn't really even big enough that a-star would help.
+
+If you parse the maze into an *fgl* graph, you can use something like `sp ::
+Node -> Node -> gr a b -> Maybe Path` to get the shortest path. However,
+because we're here anyway, I'm going to paste in my personal BFS code that I
+use for these challenges that I wrote a while ago, where neighborhoods are
+given by an `n -> Set n` function. It uses a `Seq` as its internal queue, which
+is my favorite queue type in Haskell.
+
+```haskell
+data BFSState n = BS
+  { _bsClosed :: !(Map n (Maybe n))
+  -- ^ map of item to "parent"
+  , _bsOpen :: !(Seq n)
+  -- ^ queue
+  }
+
+bfs :: forall n. Ord n => (n -> Set n) -> n -> (n -> Bool) -> Maybe [n]
+bfs ex x0 dest = reconstruct <$> go (addBack x0 Nothing (BS M.empty Seq.empty))
+  where
+    reconstruct :: (n, Map n (Maybe n)) -> [n]
+    reconstruct (goal, mp) = drop 1 . reverse $ goreco goal
+      where
+        goreco n = n : maybe [] goreco (mp M.! n)
+    go :: BFSState n -> Maybe (n, Map n (Maybe n))
+    go BS{..} = case _bsOpen of
+      Empty -> Nothing
+      n :<| ns
+        | dest n -> Just (n, _bsClosed)
+        | otherwise -> go . S.foldl' (processNeighbor n) (BS _bsClosed ns) $ ex n
+    addBack :: n -> Maybe n -> BFSState n -> BFSState n
+    addBack x up BS{..} =
+      BS
+        { _bsClosed = M.insert x up _bsClosed
+        , _bsOpen = _bsOpen :|> x
+        }
+    processNeighbor :: n -> BFSState n -> n -> BFSState n
+    processNeighbor curr bs0@BS{..} neighb
+      | neighb `M.member` _bsClosed = bs0
+      | otherwise = addBack neighb (Just curr) bs0
+
+type Point = V2 Int
+
+cardinalNeighbsSet :: Point -> Set Point
+cardinalNeighbsSet p = S.fromDistinctAscList . map (p +) $
+    [ V2 (-1) 0 , V2 0 (-1) , V2 0 1 , V2 1 0 ]
+
+solveMaze :: Set Point -> Maybe Int
+solveMaze walls = length <$> bfs step 0 (== 70)
+  where
+    step p = S.filter (all (inRange (0, 70))) $ cardinalNeighbsSet p `S.difference` walls
+```
+
+Now if you have a list of points `[Point]`, for part 1 you just solve the maze
+after taking the first 1024 of them:
+
+```haskell
+part1 :: [Point] -> Maybe Int
+part1 = solveMaze . S.fromList . take 1024
+```
+
+For part 2, you can search for the first success, or you can do a binary
+search.
+
+```haskell
+-- | Find the lowest value where the predicate is satisfied within the
+-- given bounds.
+binaryMinSearch :: (Int -> Bool) -> Int -> Int -> Maybe Int
+binaryMinSearch p = go
+  where
+    go !x !y
+      | x == mid || y == mid = Just (x + 1)
+      | p mid = go x mid
+      | otherwise = go mid y
+      where
+        mid = ((y - x) `div` 2) + x
+```
+
+```haskell
+part2 :: [Point] -> Maybe Int
+part2 pts = do
+    j <- binaryMinSearch (isNothing . solveMaze . (!! wallList)) 0 (length pts)
+    pure $ pts !! (j - 1)
+  where
+    wallList = scanl (flip S.insert) S.empty pts
+```
+
+You should probably use a container type with better indexing than a list,
+though.
diff --git a/reflections/2024/day19.md b/reflections/2024/day19.md
new file mode 100644
index 0000000..99f3696
--- /dev/null
+++ b/reflections/2024/day19.md
@@ -0,0 +1,82 @@
+This one can be solved using an infinite trie --- we build up an infinite trie
+of possibilities using patterns, and then look up a given design by tearing
+down that trie. Written altogether that gives us a hylomorphism! I've written
+about using tries with recursion schemes [in my
+blog](https://blog.jle.im/entry/tries-with-recursion-schemes.html), so this
+seemed like a natural extension.
+
+```haskell
+data CharTrie a = CT {ctHere :: Maybe a, ctThere :: IntMap (CharTrie a)}
+  deriving stock (Show, Functor, Traversable, Foldable)
+
+makeBaseFunctor ''CharTrie
+
+-- generates for us:
+data CharTrieF a r = CTF {ctHereF :: Maybe a, ctThereF :: Map Char r}
+  deriving stock (Show, Functor, Traversable, Foldable)
+```
+
+We can parameterize on a monoid `a` to solve both parts. For part 1, `a` is
+`()`: `Just ()` means that the design is in the trie, and `Nothing` means it is
+not.  For part 2, `a` is `Sum Int`: `Just (Sum n)` means there are `n` ways to get
+this design, and `Nothing` means the design is unreachable.
+
+First, the lookup algebra, which is standard for tries:
+
+```haskell
+lookupAlg :: CharTrieF a (String -> Maybe a) -> String -> Maybe a
+lookupAlg CTF{..} = \case
+  [] -> ctHereF
+  c : cs -> ($ cs) =<< M.lookup c ctThereF
+```
+
+If we had a `CharTrie a`, then `cata lookupAlg myTree "hello"` would look up
+`"hello"` in the trie.
+
+The buildup co-algebra is an interesting one.  We will convert a `Map String a`
+into a `CharTrie a`, _but_, every time we reach the end of the string, we
+"restart" the building from the start, while merging all of the resulting
+leaves monoidally. So, we'll take a `Set String` as well, which we will trigger
+when we hit the end of a pattern.
+
+```haskell
+fromMapCoalg ::
+  forall a.
+  (Semigroup a) =>
+  Set String ->
+  Map String a ->
+  CharTrieF a (Map String a)
+fromMapCoalg mp0 = \ks ->
+  let x = M.lookup [] ks
+      reAdd = case x of
+        Nothing -> id
+        Just y -> M.unionWith (M.unionWith (<>)) (M.fromSet (const y) <$> initialSplit)
+   in CTF x $ reAdd (splitTrie ks)
+  where
+    initialSplit :: Map Char (Set String)
+    initialSplit = M.fromAscListWith (<>) [ (k, S.singleton ks) | k : ks <- toList mp0 ]
+    splitTrie :: Map String a -> Map Char (Map String a)
+    splitTrie mp = M.fromAscListWith (<>) [ (k, M.singleton ks x) | (k : ks, x) <- M.toList mp ]
+```
+
+And that's it! Our hylomorphism will build up the infinite trie, but _only_ the
+specific branch that we end up looking up from it. Because it's a hylomorphism,
+we never actually generate any trie structure: we basically build up only the
+branch we care about (driven by the lookup) and stop when we finish looking up
+or hit a dead end.
+
+```haskell
+buildable :: (Semigroup a) => a -> Set String -> String -> Maybe a
+buildable x mp = hylo lookupAlg (fromMapCoalg mp) (M.fromSet (const x) mp)
+
+part1 :: Set String -> [String] -> Int
+part1 pats = length . mapMaybe (buildable () pats)
+
+part2 :: Set String -> [String] -> Int
+part2 pats = getSum . foldMap (fold . buildable (Sum 1) pats)
+```
+
+However, this may be a case where the hylomorphism is slower than doing the
+unfold and fold separately, because the full `CharTrie` is actually going to be
+re-used multiple times for each design. However, there's something a little
+more satisfying about just re-building and tearing down every time.
diff --git a/reflections/2024/day20.md b/reflections/2024/day20.md
new file mode 100644
index 0000000..7a92b02
--- /dev/null
+++ b/reflections/2024/day20.md
@@ -0,0 +1,54 @@
+Because this is a "race track" with no branching, finding the path to the end
+can be a straightforward DFS with no-takebacksies:
+
+```haskell
+cardinalNeighbsSet :: Point -> Set Point
+cardinalNeighbsSet p = S.fromDistinctAscList . map (p +) $
+    [ V2 (-1) 0 , V2 0 (-1) , V2 0 1 , V2 1 0 ]
+
+racePath :: Set Point -> Point -> Point -> Maybe [Point]
+racePath walls start end = go Nothing start
+  where
+    go :: Maybe Point -> Point -> Maybe [Point]
+    go prev here = do
+      next <- S.lookupMin candidates
+      (here :)
+        <$> if next == end
+          then pure [end]
+          else go (Just here) next
+      where
+        candidates = maybe id S.delete prev $ cardinalNeighbsSet here `S.difference` walls
+```
+
+Since our racepath is one continuous line, a cheat therefore involves
+"pinching" the line so that you skip straight over one segment of the line. So,
+we can basically iterate over each point in the line and imagine if we jumped
+ahead N spaces. If the time saved by jumping N spaces minus the real-world
+distance is greater than the threshold, it's a legitimate cheat.
+
+```haskell
+mannDist :: Point -> Point
+mannDist x y = sum (abs (x - y))
+
+mannNorm :: Point -> Int
+mannNorm = mannDist 0
+
+findCheats :: Set Point -> Point -> Point -> Int -> Int -> Maybe Int
+findCheats walls start end len thresh = do
+  path <- racePath walls start end
+  pure . sum . snd $ mapAccumR go (0, M.empty) path
+  where
+    go :: (Int, Map Point Int) -> Point -> ((Int, Map Point Int), Int)
+    go (i, xs) x =
+      ( (i + 1, M.insert x i xs)
+      , M.size $
+          M.filterWithKey (\y j -> let d = mannDist x y in d <= len && i - j - d >= thresh) xs
+      )
+```
+
+Our `mapAccumR` here iterates from the end of the list with the index (`i`) and
+a map `xs` of points to the index where that point is on the racetrack. At each
+point, we output the number of cheats: it's the `xs` filtered by points legally
+jumpable within a given distance, and then further filtered where the jump in
+index `i - j` minus the time to travel `mannDist x y` is greater than the
+threshold for counting the cheat.  In the end we sum all of those outputs.
diff --git a/reflections/2024/day21.md b/reflections/2024/day21.md
new file mode 100644
index 0000000..56ef49d
--- /dev/null
+++ b/reflections/2024/day21.md
@@ -0,0 +1,51 @@
+Everything reveals itself if we imagine a lookup table of "best path from A to
+B".  For my own purposes I've made the functions parameterized by button pad,
+using `Maybe a`, where `Nothing` is the `A` key and `Just x` is the `x` key.
+
+```haskell
+type LookupTable a b = Map (Maybe a) (Map (Maybe a) [Maybe b])
+
+type LookupTableLengths a = Map (Maybe a) (Map (Maybe a) Int)
+
+toLengths :: LookupTable a b -> LookupTableLengths a
+toLengths = fmap (fmap length)
+```
+
+The key is that now these maps are composable:
+
+```haskell
+spellDirPathLengths :: Ord a => LookupTableLengths a -> [Maybe a] -> Int
+spellDirPathLengths mp xs = sum $ zipWith (\x y -> (mp M.! x) M.! y) xs (drop 1 xs)
+
+composeDirPathLengths :: Ord b => LookupTableLengths b -> LookupTable a b -> LookupTableLengths a
+composeDirPathLengths mp = (fmap . fmap) (spellDirPathLengths mp . (Nothing :))
+```
+
+That is, if you have the lookup table for two layers, you can compose them to
+create one big lookup table.
+
+```haskell
+data Dir = North | East | West | South
+data NumButton = Finite 10
+
+dirPathChain :: [LookupTableLengths NumButton]
+dirPathChain = iterate (`composeDirPathLengths` dirPath @Dir) (dirPathCosts @Dir)
+
+solveCode :: Int -> [Maybe NumButton] -> Int
+solveCode n = spellDirPathLengths mp . (Nothing :)
+  where
+    lengthChain = dirPathChain !! (n - 1)
+    mp = lengthChain `composeDirPathLengths` dirPath @NumButton
+````
+
+The nice thing is that you only need to compute `dirPathChain` once, to get the
+final `LookupTableLengths` for a given `n`, and you can re-use it for
+everything.
+
+Generating the actual `LookupTable NumButton Dir` and `LookupTable Dir Dir` is
+the tricky part. For me I generated it based on the shortest path considering
+the third bot up the chain from the bottom: I used an *fgl* graph where the
+nodes were the state of three bots and the edges were the actions that the
+fourth "controller" would take, and computed the shortest path in terms of the
+fourth controller.  This seems to be the magic number: anything higher and you
+get the same answer, anything lower and you get suboptimal final paths.
diff --git a/reflections/2024/day22.md b/reflections/2024/day22.md
new file mode 100644
index 0000000..cd81a4c
--- /dev/null
+++ b/reflections/2024/day22.md
@@ -0,0 +1,51 @@
+First let's set up the RNG step:
+
+```haskell
+step :: Int -> Int
+step = prune . phase3 . prune . phase2 . prune . phase1
+  where
+    phase1 n = (n `shift` 6) `xor` n
+    phase2 n = (n `shift` (-5)) `xor` n
+    phase3 n = (n `shift` 11) `xor` n
+    prune = (.&. 16777215)
+```
+
+Part 1 is just running and summing:
+
+
+```haskell
+part1 :: [Int] -> Int
+part1 = sum . map ((!! 2000) . iterate)
+```
+
+Part 2 is a little more interesting. We want to make a map of 4-sequences to
+the first price they would get. On a chain of iterations, we can iteratively
+chomp on runs of 4:
+
+```haskell
+chompChomp :: [Int] -> [([Int], Int)]
+chompChomp (a : b : c : d : e : fs) =
+    ([da, db, dc, dd], e) : chompChomp (b : c : d : e : fs)
+  where
+    da = b - a
+    db = c - b
+    dc = d - c
+    dd = e - d
+chompChomp _ = []
+
+priceForChain :: Int -> Map [Int] Int
+priceForChain = M.fromListWith (const id) . chompChomp . take 2000 . map (`mod` 10) . iterate step
+```
+
+Then we can sum all of the sequence prices and get the maximum:
+
+```haskell
+part2 :: [Int] -> Int
+part2 = maximum . M.elems . M.fromListWith (+) . map priceForChain
+```
+
+I'm not super happy with the fact that this takes 3 seconds (even after
+optimizing to using `IntMap` on a base-19 encoding of the sequence). Switching
+to a single mutable vector doing all of the summing (and a mutable vector for
+every seed preventing double-adds) we bring it down to 800ms which still isn't
+particularly ideal.
diff --git a/reflections/2024/day23.md b/reflections/2024/day23.md
new file mode 100644
index 0000000..1516313
--- /dev/null
+++ b/reflections/2024/day23.md
@@ -0,0 +1,57 @@
+This one end up being a nice hylomorphism.
+
+We can build the upper triangle of the adjacency map: only include edges from
+items to items later in the alphabet.
+
+```haskell
+connMap :: Ord a => [(a, a)] -> Map a (Set a)
+connMap xs =
+  M.unionsWith
+    (<>)
+    [ M.fromList [(a, S.singleton b), (a, S.empty)]
+    | [a, b] <- xs <&> \(x, y) -> sort [x, y]
+    ]
+```
+
+Part 1 we can manually unroll:
+
+```haskell
+part1 :: Map a (Set a) -> Int
+part1 conns = length do
+    (a, adjA) <- M.toList conns
+    b <- toList adjA
+    c <- toList $ (conns M.! b) `S.intersection` adjA
+    guard $ any ("t" `isPrefixOf`) [a, b, c]
+```
+
+This is using the list monad's non-determinism for a depth first search:
+For every item `a`, all of the items `b` in its adjacencies are valid in its
+triple.  From there we can add any item `c` in the adjacencies of `b`, provided
+`c` is also in `fromA`, the adjacencies from `as`.
+
+Part 2 is where things get fun. One way to look at it is, from each starting
+point, build a tree of all adjacency hops from it at are valid: each next child
+they must be reachable from all of its parents. Then, collapse all branching
+paths from top to bottom.
+
+Therefore, our base functor is a list of parents to children:
+
+```haskell
+newtype Branch a = Branch { unBranch :: [(String, a)] }
+  deriving Functor
+```
+
+And now we are in good shape to write our hylomorphism:
+
+```haskell
+allCliques :: Ord a => Map a (Set a) -> [[a]]
+allCliques conns = hylo tearDown build (M.toList conns)
+  where
+    build = Branch
+          . map (\(a, cands) -> (a, [(b, cands `S.intersection` (conns M.! b)) | b <- toList cands]))
+    tearDown = foldMap (\(here, there) -> (here :) <$> if null there then pure [] else there)
+             . unBranch
+
+part2 :: Map a (Set a) -> [a]
+part2 = maximumBy (comparing length) . allCliques
+```
diff --git a/reflections/2024/day24.md b/reflections/2024/day24.md
new file mode 100644
index 0000000..587c5ce
--- /dev/null
+++ b/reflections/2024/day24.md
@@ -0,0 +1,145 @@
+Let's make a nice flexible `Gate` Functor/Traversable that will guide us along
+our journey.
+
+```haskell
+data Op = OAnd | OOr | OXor
+  deriving stock (Eq, Ord, Show, Generic)
+
+data Gate a = Gate {gOp :: Op, gX :: a, gY :: a}
+  deriving stock (Show, Generic, Functor, Traversable, Foldable)
+
+applyGate :: Gate Bool -> Bool
+applyGate Gate{..} = case gOp of
+  OAnd -> gX && gY
+  OOr -> gX || gY
+  OXor -> gX /= gY
+```
+
+Part 1 we can use the typical knot-tying trick: from a `Map String (Gate
+String)`, generate a `Map String Bool` of labels to their results, by referring
+to that same result.  We use the `Functor` instance of `Gate` to get `fmap (M.!
+result) :: Gate String -> Gate Bool`.
+
+```haskell
+part1 :: Map String Bool -> Map String (Gate String) -> Int
+part1 inputs gates = sum [ 2 ^ read n | ('z':n, True) <- M.toList result ]
+  where
+    result :: Map String Bool
+    result = inputs <> fmap (applyGate . fmap (M.! result)) gates
+```
+
+Now part 2, the fun part. One thing we can do is generate a full adder, by
+creating a _tree_ of `Gate`s. We can use `Free` to create a tree of nested
+Gates, since `Free f a = Pure a | Free (f (Free f a))`.
+
+```haskell
+type GateTree = Free Gate
+
+halfAdder :: GateTree a -> GateTree a -> (GateTree a, GateTree a)
+halfAdder x y = (wrap $ Gate OAnd x y, wrap $ Gate OXor x y)
+
+-- | returns carry bit and output bit
+fullAdder :: GateTree a -> GateTree a -> GateTree a -> (GateTree a, GateTree a)
+fullAdder x y carry0 = (wrap $ Gate OOr carry1 carry2, o)
+  where
+    (carry1, z) = halfAdder x y
+    (carry2, o) = halfAdder z carry0
+
+-- | returns final carry bit and all n output bits
+adderTree :: Int -> (GateTree String, NonEmpty (GateTree String))
+adderTree n
+  | n == 0 = (:| []) `second` halfAdder (pure "x00") (pure "y00")
+  | otherwise =
+      let (carryIn, rest) = adderTree (n - 1)
+          (carryOut, new) = fullAdder (pure (printf "x%02d" n)) (pure (printf "y%02d" n)) carryIn
+       in (carryOut, new `NE.cons` rest)
+```
+
+Now for the magic of `Free`: We can collapse it all into a flattened free
+structure using `iterA`, which "folds" each layer of the free structure. We
+built up a map of known gates and assign unknown gates to a new unique ID,
+creating a `Map (Gate (Either Int String)) Int`. `Left` means that the gate
+points to a known `Int` id and `Right` means it was an input `xNN`/`yNN`
+variable.
+
+```haskell
+unrollGates ::
+  forall a. Ord a => GateTree a -> State (Int, Map (Gate (Either Int a)) Int) (Either Int a)
+unrollGates = iterA go . fmap Right
+  where
+    go g0 = do
+      gate <- sequenceA g0
+      (currIx, currMp) <- get
+      case M.lookup gate currMp of
+        Nothing -> do
+          put (currIx + 1, M.insert gate currIx currMp)
+          pure $ Left currIx
+        Just i -> pure $ Left i
+
+unrollAdderTree :: Int -> ([Int], IntMap (Gate (Either Int String)))
+unrollAdderTree n = (lefts $ toList outs, IM.fromList $ swap <$> M.toList mp)
+  where
+    (carry, adder) = adderTree n
+    full = NE.reverse $ carry `NE.cons` adder
+    (outs, (_, mp)) = runState (traverse unrollGates full) (0, M.empty)
+```
+
+We wrapped it all up with `unrollAdderTree`, which returns the map of gate Int
+id's and also all of the top-level output id's. This works because all of the
+adders in `carry`/`adder`/`full` are the top-level outputs, so `traverse` pulls
+out those `Int`s as its final result.
+
+Finally we can wrap it all up in the list monad for a search. The whole thing
+is composing `NameState -> [NameState]` branches using `>=>`, where dead-ends
+are indicated by an empty list returned.
+
+```haskell
+data NameState = NS
+  { nsRenames :: Map String String
+  , nsNames :: IntMap String
+  , nsFound :: Bool
+  }
+
+nameGate :: Map (Gate String) String -> Int -> Gate (Either Int String) -> NameState -> [NameState]
+nameGate avail ng g0 NS{..} =
+  case applySwaps nsRenames <$> M.lookup gate avail of
+    Nothing -> []
+    Just here ->
+      -- the all-goes-well branch
+      NS{nsNames = IM.insert ng here nsNames, ..}
+      -- all possible substitutions/switches
+        : [ NS renames (IM.insert ng there nsNames) True
+          | not nsFound
+          , there <- toList avail
+          , here /= there
+          , let renames = M.fromList [(here, there), (there, here)] <> nsRenames
+          ]
+  where
+    gate = either (nsNames IM.!) id <$> g0
+    applySwaps mp x = M.findWithDefault x x mp
+
+nameTree :: Map (Gate String) String -> [Map String String]
+nameTree avail = nsRenames <$> foldr (\o -> (go o >=>)) pure outGates s0
+  where
+    s0 = NS M.empty IM.empty False
+    (outGates, gates) = unrollAdderTree 44
+    go outGate ns0
+      | M.size (nsRenames ns0) == 8 = [ns0]
+      | otherwise =
+          IM.foldrWithKey
+            (\k g -> (nameGate avail k g >=>))
+            pure
+            (IM.takeWhileAntitone (<= outGate) gates)
+            (ns0{nsFound = False})
+```
+
+The search is meant layer-by-layer: do all of the `z00` inputs first, then the
+`z01` inputs, etc.  There is also a major optimization that makes this all
+feasible: we only expect one swap per layer.
+
+Anyway that's it:
+
+```haskell
+part2 :: Map (Gate String) String -> [String]
+part2 = fmap M.keys . listToMaybe . nameTree
+```
diff --git a/reflections/2024/day25.md b/reflections/2024/day25.md
new file mode 100644
index 0000000..34bcca1
--- /dev/null
+++ b/reflections/2024/day25.md
@@ -0,0 +1,33 @@
+As usual, a nice relaxing day to celebrate Christmas :)
+
+Assuming we have a list of keys and locks interspersed, as `[Set (Int, Int)]`, we
+can marginalize to get the x-wise histograms and y-wise histograms:
+
+```haskell
+marginX :: Set (Int, Int) -> Map Int Int
+marginX = M.fromListWith (+) . map (\(x, y) -> (x, 1)) . toList
+
+marginY :: Set (Int, Int) -> Map Int Int
+marginY = M.fromListWith (+) . map (\(x, y) -> (y, 1)) . toList
+```
+
+We can distinguish keys from locks by checking if y=0 has all 5 points filled:
+
+```haskell
+isLock :: Set (Int, Int) -> Bool
+isLock = (== 5) . M.findWithDefault 0 0 . marginY
+```
+
+We can check if a pair is valid by checking that none of their x margins add up
+to greater than 7.  Wrapping it all in the list monad's cartesian product and
+we get:
+
+```haskell
+day25 :: [Set (Int, Int)] -> Int
+day25 = uncurry countCombos . partition isLock
+  where
+    countCombos locks keys = length do
+      lock <- marginX <$> locks
+      key <- marginX <$> keys
+      guard $ all (< 8) (M.unionWith (+) lock key)
+```
diff --git a/site/default.nix b/site/default.nix
index 0093ccb..3e1351b 100644
--- a/site/default.nix
+++ b/site/default.nix
@@ -25,6 +25,9 @@ let
                     ${lib.removeSuffix "\n\n" (builtins.readFile daymap.benchmark)}
                     ```
                   '';
+                standaloneLink = lib.optionalString
+                  (builtins.hasAttr "reflection" daymap)
+                  " / *[Standalone][d${daylong}s]*";
                 body =
                   ''
                     Day ${dayshort}
@@ -35,10 +38,10 @@ let
                     `./reflections/${year}/day${daylong}.md`.  If you want to edit this, edit that file instead!
                     -->
 
-                    *[Top](#)* / *[Prompt][d${daylong}p]* / *[Code][d${daylong}g]* / *[Standalone][d${daylong}s]*
+                    *[Top](#)* / *[Prompt][d${daylong}p]* / *[Code][d${daylong}g]*${standaloneLink}
 
                     [d${daylong}p]: https://adventofcode.com/${year}/day/${dayshort}
-                    [d${daylong}g]: https://github.com/${github}/advent-of-code/blob/master/${year}/AOC${year}/Day${daylong}.hs
+                    [d${daylong}g]: https://github.com/${github}/advent-of-code/blob/main/${year}/AOC${year}/Day${daylong}.hs
                     [d${daylong}s]: https://github.com/mstksg/advent-of-code/blob/main/reflections/${year}/day${daylong}.md
 
                     ${lib.optionalString
@@ -58,10 +61,12 @@ let
             let y2 = lib.removePrefix "aoc" n2;
             in "[${y2}](https://github.com/${github}/advent-of-code/wiki/Reflections-${y2})";
             tocLink = d: dm:
-              let dshort = lib.removePrefix "0" (lib.removePrefix "day" d);
-                  caveat = if builtins.hasAttr "reflection" dm
-                    then ""
-                    else " (benchmark only)";
+              let
+                dshort = lib.removePrefix "0" (lib.removePrefix "day" d);
+                caveat =
+                  if builtins.hasAttr "reflection" dm
+                  then ""
+                  else " (benchmark only)";
               in
               ''
                 * [Day ${dshort}](https://github.com/${github}/advent-of-code/wiki/Reflections-${year}#day-${dshort})${caveat}
@@ -97,7 +102,7 @@ let
     writeTextDir "Home.md"
       ''
         Check out the reflections page for each year!
-      
+
         ${lib.concatStrings (lib.mapAttrsToList mkLink renderedMap)}
       ''
 
diff --git a/test-data/2024/21a.txt b/test-data/2024/21a.txt
new file mode 100644
index 0000000..db7b2e9
--- /dev/null
+++ b/test-data/2024/21a.txt
@@ -0,0 +1,6 @@
+029A
+980A
+179A
+456A
+379A
+>>> 126384
diff --git a/test-data/2024/21b.txt b/test-data/2024/21b.txt
new file mode 100644
index 0000000..e69de29
diff --git a/test-data/2024/22a.txt b/test-data/2024/22a.txt
new file mode 100644
index 0000000..855cc81
--- /dev/null
+++ b/test-data/2024/22a.txt
@@ -0,0 +1,5 @@
+1
+10
+100
+2024
+>>> 37327623
diff --git a/test-data/2024/22b.txt b/test-data/2024/22b.txt
new file mode 100644
index 0000000..c3c3659
--- /dev/null
+++ b/test-data/2024/22b.txt
@@ -0,0 +1,5 @@
+1
+2
+3
+2024
+>>> 23
diff --git a/test-data/2024/23a.txt b/test-data/2024/23a.txt
new file mode 100644
index 0000000..b5380bb
--- /dev/null
+++ b/test-data/2024/23a.txt
@@ -0,0 +1,33 @@
+kh-tc
+qp-kh
+de-cg
+ka-co
+yn-aq
+qp-ub
+cg-tb
+vc-aq
+tb-ka
+wh-tc
+yn-cg
+kh-ub
+ta-co
+de-co
+tc-td
+tb-wq
+wh-td
+ta-ka
+td-qp
+aq-cg
+wq-ub
+ub-vc
+de-ta
+wq-aq
+wq-vc
+wh-yn
+ka-de
+kh-ta
+co-tc
+wh-qp
+tb-vc
+td-yn
+>>> 7
diff --git a/test-data/2024/23b.txt b/test-data/2024/23b.txt
new file mode 100644
index 0000000..9f58dc1
--- /dev/null
+++ b/test-data/2024/23b.txt
@@ -0,0 +1,33 @@
+kh-tc
+qp-kh
+de-cg
+ka-co
+yn-aq
+qp-ub
+cg-tb
+vc-aq
+tb-ka
+wh-tc
+yn-cg
+kh-ub
+ta-co
+de-co
+tc-td
+tb-wq
+wh-td
+ta-ka
+td-qp
+aq-cg
+wq-ub
+ub-vc
+de-ta
+wq-aq
+wq-vc
+wh-yn
+ka-de
+kh-ta
+co-tc
+wh-qp
+tb-vc
+td-yn
+>>> co,de,ka,ta
diff --git a/test-data/2024/24a.txt b/test-data/2024/24a.txt
new file mode 100644
index 0000000..912650d
--- /dev/null
+++ b/test-data/2024/24a.txt
@@ -0,0 +1,59 @@
+x00: 1
+x01: 1
+x02: 1
+y00: 0
+y01: 1
+y02: 0
+
+x00 AND y00 -> z00
+x01 XOR y01 -> z01
+x02 OR y02 -> z02
+>>> 4
+x00: 1
+x01: 0
+x02: 1
+x03: 1
+x04: 0
+y00: 1
+y01: 1
+y02: 1
+y03: 1
+y04: 1
+
+ntg XOR fgs -> mjb
+y02 OR x01 -> tnw
+kwq OR kpj -> z05
+x00 OR x03 -> fst
+tgd XOR rvg -> z01
+vdt OR tnw -> bfw
+bfw AND frj -> z10
+ffh OR nrd -> bqk
+y00 AND y03 -> djm
+y03 OR y00 -> psh
+bqk OR frj -> z08
+tnw OR fst -> frj
+gnj AND tgd -> z11
+bfw XOR mjb -> z00
+x03 OR x00 -> vdt
+gnj AND wpb -> z02
+x04 AND y00 -> kjc
+djm OR pbm -> qhw
+nrd AND vdt -> hwm
+kjc AND fst -> rvg
+y04 OR y02 -> fgs
+y01 AND x02 -> pbm
+ntg OR kjc -> kwq
+psh XOR fgs -> tgd
+qhw XOR tgd -> z09
+pbm OR djm -> kpj
+x03 XOR y03 -> ffh
+x00 XOR y04 -> ntg
+bfw OR bqk -> z06
+nrd XOR fgs -> wpb
+frj XOR qhw -> z04
+bqk OR frj -> z07
+y03 OR x01 -> nrd
+hwm AND bqk -> z03
+tgd XOR rvg -> z12
+tnw OR pbm -> gnj
+>>> 2024
diff --git a/test-data/2024/24b.txt b/test-data/2024/24b.txt
new file mode 100644
index 0000000..e69de29