From d3d933d2a9499b9d39f4a47fcd77e0afb0276fe0 Mon Sep 17 00:00:00 2001 From: KoenDR06 Date: Thu, 4 Dec 2025 15:32:22 +0100 Subject: [PATCH 1/9] Day 4 --- src/Day2504.hs | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 79 insertions(+) create mode 100644 src/Day2504.hs diff --git a/src/Day2504.hs b/src/Day2504.hs new file mode 100644 index 0000000..4204582 --- /dev/null +++ b/src/Day2504.hs @@ -0,0 +1,79 @@ +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 From b15aa5e959d04e7a5133f8190f940e87123a81cc Mon Sep 17 00:00:00 2001 From: KoenDR06 Date: Sat, 6 Dec 2025 14:21:10 +0100 Subject: [PATCH 2/9] Day 5 --- src/Day2505.hs | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 59 insertions(+) create mode 100644 src/Day2505.hs diff --git a/src/Day2505.hs b/src/Day2505.hs new file mode 100644 index 0000000..fce2a00 --- /dev/null +++ b/src/Day2505.hs @@ -0,0 +1,59 @@ +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 From 41e9e71b66949c2694a575c62afd07e1da6ecfa7 Mon Sep 17 00:00:00 2001 From: KoenDR06 Date: Sat, 6 Dec 2025 15:01:18 +0100 Subject: [PATCH 3/9] Day 6 --- src/Day2506.hs | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 src/Day2506.hs diff --git a/src/Day2506.hs b/src/Day2506.hs new file mode 100644 index 0000000..6423414 --- /dev/null +++ b/src/Day2506.hs @@ -0,0 +1,54 @@ +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 (tail $ 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 . map 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 From 8bd28180de32674d139c0b7d8a1877d8410d8b16 Mon Sep 17 00:00:00 2001 From: KoenDR06 Date: Sat, 6 Dec 2025 15:01:18 +0100 Subject: [PATCH 4/9] Day 6 --- src/Day2506.hs | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 src/Day2506.hs diff --git a/src/Day2506.hs b/src/Day2506.hs new file mode 100644 index 0000000..fecf726 --- /dev/null +++ b/src/Day2506.hs @@ -0,0 +1,54 @@ +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 From 1e297ced3ea1bd890c0ce1398af773c856ad68f7 Mon Sep 17 00:00:00 2001 From: KoenDR06 Date: Sun, 7 Dec 2025 13:32:19 +0100 Subject: [PATCH 5/9] Day 7 --- src/Day2507.hs | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) create mode 100644 src/Day2507.hs diff --git a/src/Day2507.hs b/src/Day2507.hs new file mode 100644 index 0000000..ab69d90 --- /dev/null +++ b/src/Day2507.hs @@ -0,0 +1,50 @@ +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 From 9901c708d2fdbdc0242eb6d710043aadfa80dd4c Mon Sep 17 00:00:00 2001 From: KoenDR06 Date: Sun, 7 Dec 2025 14:10:19 +0100 Subject: [PATCH 6/9] benchmark results --- src/Day2501.hs | 8 ++++++++ src/Day2502.hs | 8 ++++++++ src/Day2503.hs | 8 ++++++++ src/Day2504.hs | 8 ++++++++ src/Day2505.hs | 8 ++++++++ src/Day2506.hs | 8 ++++++++ src/Day2507.hs | 8 ++++++++ template.hs | 6 ++++++ 8 files changed, 62 insertions(+) diff --git a/src/Day2501.hs b/src/Day2501.hs index 8029395..dd52f60 100644 --- a/src/Day2501.hs +++ b/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)) diff --git a/src/Day2502.hs b/src/Day2502.hs index b08f473..82cae20 100644 --- a/src/Day2502.hs +++ b/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) diff --git a/src/Day2503.hs b/src/Day2503.hs index f84acae..d3beff3 100644 --- a/src/Day2503.hs +++ b/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) diff --git a/src/Day2504.hs b/src/Day2504.hs index 4204582..4109cab 100644 --- a/src/Day2504.hs +++ b/src/Day2504.hs @@ -1,3 +1,11 @@ +{- + +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) diff --git a/src/Day2505.hs b/src/Day2505.hs index fce2a00..9ed397a 100644 --- a/src/Day2505.hs +++ b/src/Day2505.hs @@ -1,3 +1,11 @@ +{- + +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) diff --git a/src/Day2506.hs b/src/Day2506.hs index fecf726..f280797 100644 --- a/src/Day2506.hs +++ b/src/Day2506.hs @@ -1,3 +1,11 @@ +{- + +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) diff --git a/src/Day2507.hs b/src/Day2507.hs index ab69d90..dde6289 100644 --- a/src/Day2507.hs +++ b/src/Day2507.hs @@ -1,3 +1,11 @@ +{- + +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) diff --git a/template.hs b/template.hs index 0f65d1d..ccea37f 100644 --- a/template.hs +++ b/template.hs @@ -1,3 +1,9 @@ +{- + +< BENCHMARK RESULTS HERE > + +-} + module Main where part1 :: String -> Int From 7061a1d3e63b552cb44a1e0102d79a57e0f49317 Mon Sep 17 00:00:00 2001 From: KoenDR06 Date: Mon, 22 Dec 2025 15:45:59 +0100 Subject: [PATCH 7/9] Day 8 --- src/Day2508.hs | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 64 insertions(+) create mode 100644 src/Day2508.hs diff --git a/src/Day2508.hs b/src/Day2508.hs new file mode 100644 index 0000000..8587102 --- /dev/null +++ b/src/Day2508.hs @@ -0,0 +1,64 @@ +{- + +< BENCHMARK RESULTS HERE > + +-} + +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 From 35707aa5a6c36d0293e3bb593605be5e17e25e2a Mon Sep 17 00:00:00 2001 From: KoenDR06 Date: Mon, 22 Dec 2025 15:46:21 +0100 Subject: [PATCH 8/9] flake --- flake.lock | 27 +++++++++++++++++++++++++++ flake.nix | 21 +++++++++++++++++++++ 2 files changed, 48 insertions(+) create mode 100644 flake.lock create mode 100644 flake.nix diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..9105d93 --- /dev/null +++ b/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 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..ae661e6 --- /dev/null +++ b/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 + ])) + ]; + }; + }; +} From 9c927cefc955a3377bb9e6169b5ac364f72aa042 Mon Sep 17 00:00:00 2001 From: KoenDR06 Date: Mon, 22 Dec 2025 15:47:28 +0100 Subject: [PATCH 9/9] add bench to day 8 --- src/Day2508.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Day2508.hs b/src/Day2508.hs index 8587102..db19fc6 100644 --- a/src/Day2508.hs +++ b/src/Day2508.hs @@ -1,6 +1,8 @@ {- -< BENCHMARK RESULTS HERE > +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 -}