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 + ])) + ]; + }; + }; +} 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 new file mode 100644 index 0000000..4109cab --- /dev/null +++ b/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 diff --git a/src/Day2505.hs b/src/Day2505.hs new file mode 100644 index 0000000..9ed397a --- /dev/null +++ b/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 diff --git a/src/Day2506.hs b/src/Day2506.hs new file mode 100644 index 0000000..f280797 --- /dev/null +++ b/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 diff --git a/src/Day2507.hs b/src/Day2507.hs new file mode 100644 index 0000000..dde6289 --- /dev/null +++ b/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 diff --git a/src/Day2508.hs b/src/Day2508.hs new file mode 100644 index 0000000..db19fc6 --- /dev/null +++ b/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 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