add bench to day 8

flake.lock

@@ -0,0 +1,27 @@
+{
+  "nodes": {
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1766201043,
+        "narHash": "sha256-eplAP+rorKKd0gNjV3rA6+0WMzb1X1i16F5m5pASnjA=",
+        "owner": "nixos",
+        "repo": "nixpkgs",
+        "rev": "b3aad468604d3e488d627c0b43984eb60e75e782",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nixos",
+        "ref": "nixos-25.11",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "nixpkgs": "nixpkgs"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}

flake.nix

@@ -0,0 +1,21 @@
+{
+  description = "Haskell flake";
+
+  inputs = {
+    nixpkgs.url = "github:nixos/nixpkgs/nixos-25.11";
+  };
+
+  outputs = { self, nixpkgs }: let
+    system = "x86_64-linux";
+    pkgs = import nixpkgs { inherit system; };
+  in {
+    devShells.${system}.default = pkgs.mkShell {
+      packages = [(
+        pkgs.haskellPackages.ghcWithPackages (hp: with hp; [
+          extra
+          hoogle
+        ]))
+      ];
+    };
+  };
+}

src/Day2501.hs

@@ -1,3 +1,11 @@
+{-
+
+Benchmark 1: ./out
+  Time (mean ± σ):       9.3 ms ±   1.2 ms    [User: 7.2 ms, System: 1.9 ms]
+  Range (min … max):     7.8 ms …  12.0 ms    10 runs
+
+-}
+
 module Main where
 
 convertToInts = map (\it -> (if head it == 'L' then -1 else 1) * read (drop 1 it))

src/Day2502.hs

@@ -1,3 +1,11 @@
+{-
+
+Benchmark 1: ./out
+  Time (mean ± σ):     10.357 s ±  0.237 s    [User: 10.297 s, System: 0.045 s]
+  Range (min … max):    9.868 s … 10.727 s    10 runs
+
+-}
+
 module Main where
 
 import Data.List (find, nub)

src/Day2503.hs

@@ -1,3 +1,11 @@
+{-
+
+Benchmark 1: ./out
+  Time (mean ± σ):      61.9 ms ±   1.3 ms    [User: 58.6 ms, System: 3.0 ms]
+  Range (min … max):    60.4 ms …  64.4 ms    10 runs
+
+-}
+
 module Main where
 
 import Data.List (tails, singleton)

src/Day2504.hs

@@ -0,0 +1,87 @@
+{-
+
+Benchmark 1: ./out
+  Time (mean ± σ):      1.417 s ±  0.016 s    [User: 1.410 s, System: 0.005 s]
+  Range (min … max):    1.398 s …  1.443 s    10 runs
+
+-}
+
+module Main where
+
+import Debug.Trace (trace)
+
+guard :: Bool -> [()]
+guard True  = [()]
+guard False = []
+
+gridMap :: (a -> b) -> [[a]] -> [[b]]
+gridMap f = map (map f)
+
+gridMapWithIndex :: ((Int, Int) -> a -> b) -> [[a]] -> [[b]]
+gridMapWithIndex f grid = map (\(y, row) -> map (\(x, cell) -> (f (x,y) cell)) $ zip [0..] row) $ zip [0..] grid
+
+--------------------
+----- Problems -----
+--------------------
+
+isReachable :: [String] -> (Int, Int) -> Bool
+isReachable input (x,y) = let
+  w = length (head input)
+  h = length       input
+  in ((< (4+1)) . length) $ do
+  dy <- [-1..1]
+  dx <- [-1..1]
+
+  let ax = dx+x
+  let ay = dy+y
+
+  guard $ (ax >= 0 && ax < w && ay >= 0 && ay < h)
+
+  guard $ (input!!(y+dy))!!(x+dx) == '@'
+
+  return ()
+
+part1 :: String -> Int
+part1 str = length $ filter id a
+  where
+  w = length (head input)
+  h = length       input
+
+  input = lines str
+  a = do
+    y <- [0..w-1]
+    x <- [0..h-1]
+
+    guard $ (input!!y)!!x == '@'
+
+    return $ isReachable input (x,y)
+
+part2 :: String -> Int
+part2 str = go grid
+  where
+  grid = lines str
+  w = length (head grid)
+  h = length       grid
+
+  countBoxes = length . filter id . concat . gridMap (\c -> if c=='@' then True else False)
+
+  go :: [[Char]] -> Int
+  go grid | startCount == endCount = 0
+          | otherwise              = (startCount - endCount) + go end
+    where
+    startCount = countBoxes grid
+    end = iter grid
+    endCount   = countBoxes end
+
+  iter :: [[Char]] -> [[Char]]
+  iter input = gridMapWithIndex select input
+    where
+    select = \(x,y) c -> if c == '@' then if isReachable input (x,y) then '.' else '@' else c
+
+
+main :: IO ()
+main = do
+  str <- getContents
+
+  print $ part1 str
+  print $ part2 str

src/Day2505.hs

@@ -0,0 +1,67 @@
+{-
+
+Benchmark 1: ./out
+  Time (mean ± σ):       9.8 ms ±   1.3 ms    [User: 6.7 ms, System: 2.9 ms]
+  Range (min … max):     8.3 ms …  12.0 ms    10 runs
+
+-}
+
+module Main where
+
+import Data.List (find)
+import Data.Maybe (fromJust, isNothing, isJust)
+
+type Range = (Int, Int)
+
+takeDropWhile :: (a -> Bool) -> [a] -> ([a], [a])
+takeDropWhile f xs = (takeWhile f xs, drop 1 $ dropWhile f xs)
+
+remove :: Eq a => a -> [a] -> [a]
+remove d []     = []
+remove d (x:xs) | d == x    =            xs
+                | otherwise = x:remove d xs
+
+part1 :: String -> Int
+part1 str = length $ filter id $ map isIdValid availableIds
+  where
+  input = lines str
+
+  (ranges, ids) = takeDropWhile (/="") input
+
+  freshRanges :: [Range]
+  freshRanges = map ((\(a,b)-> (read a, read b)) . takeDropWhile (/='-')) ranges
+
+  availableIds :: [Int]
+  availableIds = map read ids
+
+  isIdValid :: Int -> Bool
+  isIdValid n = any (\(lo,hi) -> n >= lo && n <= hi) freshRanges
+
+part2 :: String -> Int
+part2 str = sum $ map (\(lo, hi) -> hi - lo + 1) $ mergeRanges freshRanges
+  where
+  input = lines str
+
+  freshRanges :: [Range]
+  freshRanges = map ((\(a,b) -> (read a, read b)) . takeDropWhile (/='-')) $ takeWhile (/="") input
+
+  merge :: Range -> Range -> Range
+  merge a@(loA, hiA) b@(loB, hiB) = (min loA loB, max hiA hiB)
+
+  mergeRanges :: [Range] -> [Range]
+  mergeRanges [] = []
+  mergeRanges (x:xs) | isJust findRes = mergeRanges (remove item ((merge item x):xs))
+                     | otherwise      = x : mergeRanges xs
+    where
+    findRes = find (not . isDisjoint x) xs
+    item = fromJust findRes
+
+  isDisjoint :: Range -> Range -> Bool
+  (loA, hiA) `isDisjoint` (loB, hiB) = loB > hiA || loA > hiB
+
+main :: IO ()
+main = do
+  str <- getContents
+
+  print $ part1 str
+  print $ part2 str -- 248440777865316 < part2

src/Day2506.hs

@@ -0,0 +1,62 @@
+{-
+
+Benchmark 1: ./out
+  Time (mean ± σ):      11.8 ms ±   1.3 ms    [User: 8.3 ms, System: 3.3 ms]
+  Range (min … max):     9.9 ms …  13.5 ms    10 runs
+
+-}
+
+module Main where
+
+import Data.List (find, transpose)
+import Data.Maybe (isNothing, isJust)
+
+splitPred :: (a -> Bool) -> [a] -> [[a]]
+splitPred _ []  = []
+splitPred f str | isNothing $ find f str = [str]
+                | otherwise              = takeWhile (not . f) str : splitPred f (drop 1 $ dropWhile (not . f) str)
+
+part1 :: String -> Int
+part1 = sum . map calcOne . transpose . parser 
+  where
+  parser :: String -> [[String]]
+  parser = map splitLine . lines
+    where
+    splitLine :: String -> [String]
+    splitLine = filter (not . null) . words
+
+  calcOne :: [String] -> Int
+  calcOne xs = foldl1 operation operands
+    where
+    operation = if last xs == "+" then (+) else (*)
+
+    operands :: [Int]
+    operands = map read $ drop 1 $ reverse xs
+  
+
+part2 :: String -> Int
+part2 = sum . map (calcOne . transpose) . parse
+  where
+  parse = splitPred (all (==' ')) . transpose . lines
+
+  calcOne :: [String] -> Int
+  calcOne xs = foldl1 operation operands
+    where
+    operation = getOperation xs
+    operands = getOperands xs
+
+    getOperands :: [String] -> [Int]
+    getOperands xs = map read $ transpose operands
+      where
+      operands = take (length xs - 1) xs
+
+    getOperation :: [String] -> (Int -> Int -> Int)
+    getOperation xs = if isJust $ find (=='+') $ last xs then (+) else (*)
+
+
+main :: IO ()
+main = do
+  str <- getContents
+
+  print $ part1 str
+  print $ part2 str

src/Day2507.hs

@@ -0,0 +1,58 @@
+{-
+
+Benchmark 1: ./out
+  Time (mean ± σ):      19.7 ms ±   1.7 ms    [User: 15.9 ms, System: 3.6 ms]
+  Range (min … max):    17.7 ms …  22.9 ms    10 runs
+
+-}
+
+module Main where
+
+import Data.List (singleton, elemIndex, nub)
+import Data.Maybe (fromJust)
+
+part1 :: String -> Int
+part1 str = go (drop 1 input) 0 beams
+  where
+  input = lines str
+
+  beams = [ fromJust $ elemIndex 'S' $ head input ]
+
+  go :: [String] -> Int -> [Int] -> Int
+  go []           acc _     = acc
+  go (line:lines) acc beams = go lines (acc + countSplits beams) $ nub $ concatMap splitBeam beams
+    where
+    countSplits :: [Int] -> Int
+    countSplits = length . filter (\beam -> (line !! beam) == '^')
+    
+    splitBeam beam | (line !! beam) == '^' = [beam-1, beam+1]
+                   | otherwise             = [beam]
+
+
+type Beam = (Int, Int)
+part2 :: String -> Int
+part2 str = go (drop 1 input) beams
+  where
+  input = lines str
+
+  beams = [ (fromJust $ elemIndex 'S' $ head input, 1) ]
+
+  go :: [String] -> [Beam] -> Int
+  go []           = sum . map snd
+  go (line:lines) = go lines . mergeNub . concatMap splitBeam
+    where
+    splitBeam (index, count) | (line !! index) == '^' = [(index-1, count), (index+1,count)]
+                             | otherwise              = [(index, count)]
+
+    mergeNub :: [Beam] -> [Beam]
+    mergeNub []         =  []
+    mergeNub ((i,n):xs) =  (i,n + merged) : mergeNub (filter (\(i',n') -> i /= i') xs)
+      where
+      merged = sum (map snd $ filter (\(i', n') -> i == i') xs)
+
+main :: IO ()
+main = do
+  str <- getContents
+
+  print $ part1 str
+  print $ part2 str

src/Day2508.hs

@@ -0,0 +1,66 @@
+{-
+
+Benchmark 1: ./out
+  Time (mean ± σ):     783.0 ms ±   9.3 ms    [User: 743.1 ms, System: 38.1 ms]
+  Range (min … max):   765.1 ms … 798.5 ms    10 runs
+
+-}
+
+module Main where
+
+import Debug.Trace
+import Data.Maybe (isNothing, fromMaybe, isJust, fromJust)
+import Data.List (find, tails, delete, minimumBy, nub, sort, sortOn)
+import Data.List.Split (splitOn)
+
+import Data.Set qualified as Set
+import Data.Set (Set)
+
+pairs :: [a] -> [(a,a)]
+pairs l = [(x,y) | (x:ys) <- tails l, y <- ys]
+
+type Coord = (Int, Int, Int)
+type Pair = (Coord, Coord)
+
+dist :: Pair -> Int
+dist ((a,b,c), (d,e,f)) = (d-a)^2 + (e-b)^2 + (f-c)^2
+
+part1 :: String -> Int
+part1 str = go 1000 (sortOn dist $ pairs coords) $ map (\n -> Set.fromList [n]) coords
+  where
+  coords = map ((\[x,y,z] -> (read x, read y, read z)) . splitOn ",") $ lines str
+
+  go :: Int -> [Pair] -> [Set Coord] -> Int
+  go 0 pairs            graphs = product $ map Set.size $ take 3 $ sortOn ((*(-1)) . Set.size) graphs
+  go n ((start,end):xs) graphs | isJust theSame = go (n-1) xs graphs
+                               | otherwise      = go (n-1) xs graphs'
+    where
+    theSame = find (\s -> Set.member start s && Set.member end s) graphs
+    startSet = fromJust $ find (Set.member start) graphs
+    endSet   = fromJust $ find (Set.member end  ) graphs
+
+    graphs' = Set.union startSet endSet : (delete startSet (delete endSet graphs))
+
+part2 :: String -> Int
+part2 str = go (sortOn dist $ pairs coords) $ map (\n -> Set.fromList [n]) coords
+  where
+  coords = map ((\[x,y,z] -> (read x, read y, read z)) . splitOn ",") $ lines str
+
+  go :: [Pair] -> [Set Coord] -> Int
+  go ((start,end):xs) graphs | isJust theSame   = go xs graphs
+                             | otherwise        = if length graphs' == 1 then x1*x2 else go xs graphs'
+    where
+    (x1,_,_) = start
+    (x2,_,_) = end
+    theSame = find (\s -> Set.member start s && Set.member end s) graphs
+    startSet = fromJust $ find (Set.member start) graphs
+    endSet   = fromJust $ find (Set.member end  ) graphs
+
+    graphs' = Set.union startSet endSet : (delete startSet (delete endSet graphs))
+
+main :: IO ()
+main = do
+  str <- getContents
+
+  print $ part1 str
+  print $ part2 str

template.hs

@@ -1,3 +1,9 @@
+{-
+
+< BENCHMARK RESULTS HERE >
+
+-}
+
 module Main where
 
 part1 :: String -> Int