From cff92ce34f5a5b32ce4ff35a31e99eb66b92d420 Mon Sep 17 00:00:00 2001 From: Daniele Fucini Date: Fri, 20 Dec 2024 18:00:43 +0100 Subject: [PATCH] Refactor code --- adventofcode2024.cabal | 50 ++++++---------- src/{Day01/Puzzle2.hs => Day01.hs} | 17 +++++- src/Day01/Puzzle1.hs | 16 ------ src/{Day02/Puzzle2.hs => Day02.hs} | 14 ++++- src/Day02/Puzzle1.hs | 19 ------ src/{Day03/Puzzle2.hs => Day03.hs} | 14 ++++- src/Day03/Puzzle1.hs | 17 ------ src/{Day04/Puzzle1.hs => Day04.hs} | 34 ++++++++++- src/Day04/Puzzle2.hs | 34 ----------- src/Day05.hs | 56 ++++++++++++++++++ src/Day05/Puzzle1.hs | 24 -------- src/Day05/Puzzle2.hs | 33 ----------- src/{Day06/Puzzle2.hs => Day06.hs} | 27 ++++++++- src/Day06/Puzzle1.hs | 84 --------------------------- src/Day07.hs | 56 ++++++++++++++++++ src/Day07/Puzzle1.hs | 25 -------- src/Day07/Puzzle2.hs | 33 ----------- src/{Day08/Puzzle2.hs => Day08.hs} | 27 ++++++++- src/Day08/Puzzle1.hs | 46 --------------- src/{Day09/Puzzle2.hs => Day09.hs} | 43 ++++++++++++-- src/Day09/Puzzle1.hs | 34 ----------- src/{Day10/Puzzle2.hs => Day10.hs} | 15 ++++- src/Day10/Puzzle1.hs | 29 ---------- src/{Day11/Puzzle1.hs => Day11.hs} | 13 ++++- src/Day11/Puzzle2.hs | 23 -------- src/{Day12/Puzzle1.hs => Day12.hs} | 2 +- src/{Day13/Puzzle2.hs => Day13.hs} | 28 +++++++-- src/Day13/Puzzle1.hs | 43 -------------- src/{Day14/Puzzle1.hs => Day14.hs} | 29 +++++++++- src/Day14/Puzzle2.hs | 42 -------------- src/{Day15/Puzzle1.hs => Day15.hs} | 2 +- src/{Day17/Puzzle1.hs => Day17.hs} | 2 +- src/{Day18/Puzzle2.hs => Day18.hs} | 16 +++++- src/Day18/Puzzle1.hs | 81 -------------------------- src/{Day19/Puzzle1.hs => Day19.hs} | 2 +- src/Main.hs | 92 +++++++++++++++++++----------- 36 files changed, 448 insertions(+), 674 deletions(-) rename src/{Day01/Puzzle2.hs => Day01.hs} (59%) delete mode 100644 src/Day01/Puzzle1.hs rename src/{Day02/Puzzle2.hs => Day02.hs} (73%) delete mode 100644 src/Day02/Puzzle1.hs rename src/{Day03/Puzzle2.hs => Day03.hs} (71%) delete mode 100644 src/Day03/Puzzle1.hs rename src/{Day04/Puzzle1.hs => Day04.hs} (50%) delete mode 100644 src/Day04/Puzzle2.hs create mode 100644 src/Day05.hs delete mode 100644 src/Day05/Puzzle1.hs delete mode 100644 src/Day05/Puzzle2.hs rename src/{Day06/Puzzle2.hs => Day06.hs} (83%) delete mode 100644 src/Day06/Puzzle1.hs create mode 100644 src/Day07.hs delete mode 100644 src/Day07/Puzzle1.hs delete mode 100644 src/Day07/Puzzle2.hs rename src/{Day08/Puzzle2.hs => Day08.hs} (69%) delete mode 100644 src/Day08/Puzzle1.hs rename src/{Day09/Puzzle2.hs => Day09.hs} (63%) delete mode 100644 src/Day09/Puzzle1.hs rename src/{Day10/Puzzle2.hs => Day10.hs} (67%) delete mode 100644 src/Day10/Puzzle1.hs rename src/{Day11/Puzzle1.hs => Day11.hs} (70%) delete mode 100644 src/Day11/Puzzle2.hs rename src/{Day12/Puzzle1.hs => Day12.hs} (97%) rename src/{Day13/Puzzle2.hs => Day13.hs} (66%) delete mode 100644 src/Day13/Puzzle1.hs rename src/{Day14/Puzzle1.hs => Day14.hs} (70%) delete mode 100644 src/Day14/Puzzle2.hs rename src/{Day15/Puzzle1.hs => Day15.hs} (99%) rename src/{Day17/Puzzle1.hs => Day17.hs} (99%) rename src/{Day18/Puzzle2.hs => Day18.hs} (87%) delete mode 100644 src/Day18/Puzzle1.hs rename src/{Day19/Puzzle1.hs => Day19.hs} (96%) diff --git a/adventofcode2024.cabal b/adventofcode2024.cabal index 2c639a3..1c4e0ed 100644 --- a/adventofcode2024.cabal +++ b/adventofcode2024.cabal @@ -37,35 +37,21 @@ executable adventofcode2024 -Wpartial-fields -Wredundant-constraints other-modules: - Day01.Puzzle1 - Day01.Puzzle2 - Day02.Puzzle1 - Day02.Puzzle2 - Day03.Puzzle1 - Day03.Puzzle2 - Day04.Puzzle1 - Day04.Puzzle2 - Day05.Puzzle1 - Day05.Puzzle2 - Day06.Puzzle1 - Day06.Puzzle2 - Day07.Puzzle1 - Day07.Puzzle2 - Day08.Puzzle1 - Day08.Puzzle2 - Day09.Puzzle1 - Day09.Puzzle2 - Day10.Puzzle1 - Day10.Puzzle2 - Day11.Puzzle1 - Day11.Puzzle2 - Day12.Puzzle1 - Day13.Puzzle1 - Day13.Puzzle2 - Day14.Puzzle1 - Day14.Puzzle2 - Day15.Puzzle1 - Day17.Puzzle1 - Day18.Puzzle1 - Day18.Puzzle2 - Day19.Puzzle1 + Day01 + Day02 + Day03 + Day04 + Day05 + Day06 + Day07 + Day08 + Day09 + Day10 + Day11 + Day12 + Day13 + Day14 + Day15 + Day17 + Day18 + Day19 diff --git a/src/Day01/Puzzle2.hs b/src/Day01.hs similarity index 59% rename from src/Day01/Puzzle2.hs rename to src/Day01.hs index f953407..017d70c 100644 --- a/src/Day01/Puzzle2.hs +++ b/src/Day01.hs @@ -1,15 +1,30 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module Day01.Puzzle2 (day01_2) where +module Day01 + ( day01_1, + day01_2, + ) +where import Data.List (group, sort, transpose, uncons) import Data.Maybe (fromJust) +listDistance :: [Int] -> [Int] -> Int +listDistance xs ys = sum $ map abs $ zipWith (-) (sort xs) (sort ys) + similarityScore :: [Int] -> [Int] -> Int similarityScore xs ys = let elemsY = [(fst . fromJust $ uncons y, length y) | y <- (group . sort) ys] in sum [x * snd y | x <- xs, y <- elemsY, x == fst y] +day01_1 :: IO () +day01_1 = do + contents <- lines <$> readFile "input/day1.txt" + let [x, y] = transpose $ map read . words <$> contents + putStrLn $ + "Day 1, Puzzle 1 solution: " + ++ show (listDistance x y) + day01_2 :: IO () day01_2 = do contents <- lines <$> readFile "input/day1.txt" diff --git a/src/Day01/Puzzle1.hs b/src/Day01/Puzzle1.hs deleted file mode 100644 index 7859825..0000000 --- a/src/Day01/Puzzle1.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -module Day01.Puzzle1 (day01_1) where - -import Data.List (sort, transpose) - -listDistance :: [Int] -> [Int] -> Int -listDistance xs ys = sum $ map abs $ zipWith (-) (sort xs) (sort ys) - -day01_1 :: IO () -day01_1 = do - contents <- lines <$> readFile "input/day1.txt" - let [x, y] = transpose $ map read . words <$> contents - putStrLn $ - "Day 1, Puzzle 1 solution: " - ++ show (listDistance x y) diff --git a/src/Day02/Puzzle2.hs b/src/Day02.hs similarity index 73% rename from src/Day02/Puzzle2.hs rename to src/Day02.hs index 34a7810..87e967b 100644 --- a/src/Day02/Puzzle2.hs +++ b/src/Day02.hs @@ -1,4 +1,8 @@ -module Day02.Puzzle2 (day02_2) where +module Day02 + ( day02_1, + day02_2, + ) +where import Control.Monad import Data.List (sort, sortBy) @@ -16,6 +20,14 @@ removeLevel xs = filter (\x -> length x == l) $ filterM (const [True, False]) xs where l = length xs - 1 +day02_1 :: IO () +day02_1 = do + contents <- lines <$> readFile "input/day2.txt" + let reports = map read . words <$> contents + putStrLn $ + "Day 2, Puzzle 1 solution: " + ++ show (length $ filter isSafe reports) + day02_2 :: IO () day02_2 = do contents <- lines <$> readFile "input/day2.txt" diff --git a/src/Day02/Puzzle1.hs b/src/Day02/Puzzle1.hs deleted file mode 100644 index 8570fa2..0000000 --- a/src/Day02/Puzzle1.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Day02.Puzzle1 (day02_1) where - -import Data.List (sort, sortBy) -import Data.Ord - -isSafe :: [Int] -> Bool -isSafe xs = (isAscending xs || isDescending xs) && maximum distances <= 3 && minimum distances >= 1 - where - isAscending x = x == sort x - isDescending x = x == sortBy (comparing Down) x - distances = map abs $ zipWith (-) xs (drop 1 xs) - -day02_1 :: IO () -day02_1 = do - contents <- lines <$> readFile "input/day2.txt" - let reports = map read . words <$> contents - putStrLn $ - "Day 2, Puzzle 1 solution: " - ++ show (length $ filter isSafe reports) diff --git a/src/Day03/Puzzle2.hs b/src/Day03.hs similarity index 71% rename from src/Day03/Puzzle2.hs rename to src/Day03.hs index 8f64522..5fae745 100644 --- a/src/Day03/Puzzle2.hs +++ b/src/Day03.hs @@ -1,4 +1,8 @@ -module Day03.Puzzle2 (day03_2) where +module Day03 + ( day03_1, + day03_2, + ) +where import Data.List (isPrefixOf) import Data.List.Split (split, splitOn, startsWith) @@ -12,6 +16,14 @@ sumMul xs = filterDonts :: [String] -> String filterDonts = concat . concatMap (filter (not . isPrefixOf "don't()") . split (startsWith "do()")) +day03_1 :: IO () +day03_1 = do + contents <- readFile "input/day3.txt" + let mults = getAllTextMatches (contents =~ "mul\\([0-9]+,[0-9]+\\)") :: [String] + putStrLn $ + "Day 3, Puzzle 1 solution: " + ++ show (sumMul mults) + day03_2 :: IO () day03_2 = do contents <- split (startsWith "don't()") <$> readFile "input/day3.txt" diff --git a/src/Day03/Puzzle1.hs b/src/Day03/Puzzle1.hs deleted file mode 100644 index c29ffeb..0000000 --- a/src/Day03/Puzzle1.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Day03.Puzzle1 (day03_1) where - -import Data.List.Split (splitOn) -import Text.Regex.TDFA (getAllTextMatches, (=~)) - -sumMul :: [String] -> Int -sumMul xs = - let vals = map (splitOn "," . filter (`elem` "0123456789,")) xs - in sum $ map (product . map read) vals - -day03_1 :: IO () -day03_1 = do - contents <- readFile "input/day3.txt" - let mults = getAllTextMatches (contents =~ "mul\\([0-9]+,[0-9]+\\)") :: [String] - putStrLn $ - "Day 3, Puzzle 1 solution: " - ++ show (sumMul mults) diff --git a/src/Day04/Puzzle1.hs b/src/Day04.hs similarity index 50% rename from src/Day04/Puzzle1.hs rename to src/Day04.hs index d14fdcd..02c0d78 100644 --- a/src/Day04/Puzzle1.hs +++ b/src/Day04.hs @@ -1,6 +1,10 @@ -module Day04.Puzzle1 (day04_1) where +module Day04 + ( day04_1, + day04_2, + ) +where -import Data.List (isPrefixOf, transpose) +import Data.List (isPrefixOf, tails, transpose) diagonals :: [String] -> [String] diagonals xs = diagonals' xs ++ diagonals' ((transpose . reverse) xs) @@ -26,9 +30,35 @@ countOccurrences word text = then 1 + countOccurrences' word rest else countOccurrences' w rest +countOccurrencesX :: String -> [String] -> Int +countOccurrencesX word text = + sum (map (countOccurrencesX' word) diags) + + sum (map (countOccurrencesX' word . reverse) diags) + where + diags = diagonals text + countOccurrencesX' _ [] = 0 + countOccurrencesX' w txt@(_ : rest) = + if w `isPrefixOf` txt + then 1 + countOccurrencesX' w rest + else countOccurrencesX' w rest + +submatricesVert :: Int -> [String] -> [[String]] +submatricesVert _ [] = [] +submatricesVert _ [_] = [] +submatricesVert _ [_, _] = [] +submatricesVert n matrix@(_ : xxs) = submatrix matrix ++ submatricesVert n xxs + where + submatrix m = [take n $ map (take n) m] + day04_1 :: IO () day04_1 = do contents <- lines <$> readFile "input/day4.txt" putStrLn $ "Day 4, Puzzle 1 solution: " ++ show (countOccurrences "XMAS" contents) + +day04_2 :: IO () +day04_2 = do + contents <- lines <$> readFile "input/day4.txt" + let xmas = length . concatMap (filter (\x -> countOccurrencesX "MAS" x == 2) . submatricesVert 3) . transpose $ map tails contents + putStrLn $ "Day 4, Puzzle 2 solution: " ++ show xmas diff --git a/src/Day04/Puzzle2.hs b/src/Day04/Puzzle2.hs deleted file mode 100644 index cebc8ee..0000000 --- a/src/Day04/Puzzle2.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Day04.Puzzle2 (day04_2) where - -import Data.List (isPrefixOf, tails, transpose) - -diagonals :: [String] -> [String] -diagonals xs = diagonals' xs ++ diagonals' ((transpose . reverse) xs) - where - diagonals' x = - transpose (zipWith drop [0 ..] x) - ++ transpose (zipWith drop [1 ..] (transpose x)) - -countOccurrences :: String -> [String] -> Int -countOccurrences word text = sum (map (countOccurrences' word) diags) + sum (map (countOccurrences' word . reverse) diags) - where - diags = diagonals text - countOccurrences' _ [] = 0 - countOccurrences' w txt@(_ : rest) = - if w `isPrefixOf` txt - then 1 + countOccurrences' w rest - else countOccurrences' w rest - -submatricesVert :: Int -> [String] -> [[String]] -submatricesVert _ [] = [] -submatricesVert _ [_] = [] -submatricesVert _ [_, _] = [] -submatricesVert n matrix@(_ : xxs) = submatrix matrix ++ submatricesVert n xxs - where - submatrix m = [take n $ map (take n) m] - -day04_2 :: IO () -day04_2 = do - contents <- lines <$> readFile "input/day4.txt" - let xmas = length . concatMap (filter (\x -> countOccurrences "MAS" x == 2) . submatricesVert 3) . transpose $ map tails contents - putStrLn $ "Day 4, Puzzle 2 solution: " ++ show xmas diff --git a/src/Day05.hs b/src/Day05.hs new file mode 100644 index 0000000..6c114c7 --- /dev/null +++ b/src/Day05.hs @@ -0,0 +1,56 @@ +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} + +module Day05 + ( day05_1, + day05_2, + ) +where + +import Data.List ((\\)) +import Data.List.Split (splitOn) + +isSortedS :: [(String, String)] -> [String] -> Bool +isSortedS _ [_] = True +isSortedS rules (x : xs) = + let after = [p | (p, n) <- rules, n == x] + in not (any (`elem` after) xs) && isSortedS rules xs + +isSortedI :: [(Int, Int)] -> [Int] -> Bool +isSortedI _ [_] = True +isSortedI rules (x : xs) = + let after = [p | (p, n) <- rules, n == x] + in not (any (`elem` after) xs) && isSortedI rules xs + +getMiddleS :: [String] -> String +getMiddleS xs = xs !! (length xs `div` 2) + +getMiddleI :: [Int] -> Int +getMiddleI xs = xs !! (length xs `div` 2) + +sortOnRules :: [(Int, Int)] -> [Int] -> [Int] +sortOnRules _ [] = [] +sortOnRules rules (x : xs) = sortOnRules rules beforeArray ++ [x] ++ sortOnRules rules afterArray + where + afterArray = xs \\ before + beforeArray = xs \\ afterArray + before = [p | (p, n) <- rules, n == x] + +day05_1 :: IO () +day05_1 = do + contents <- map (splitOn "|") . lines <$> readFile "input/day5.txt" + let rules = [(x, y) | [x, y] <- takeWhile (/= [""]) contents] + updates = concatMap (map (splitOn ",")) . drop 1 $ dropWhile (/= [""]) contents + sorted = filter (isSortedS rules) updates + putStrLn $ + "Day 5, Puzzle 1 solution: " + ++ (show :: Int -> String) (sum $ map (read . getMiddleS) sorted) + +day05_2 :: IO () +day05_2 = do + contents <- map (splitOn "|") . lines <$> readFile "input/day5.txt" + let rules = [(read x, read y) | [x, y] <- takeWhile (/= [""]) contents] + unsorted = filter (not . isSortedI rules) . map (map read) $ concatMap (map (splitOn ",")) . drop 1 $ dropWhile (/= [""]) contents + fixUnsorted = map (sortOnRules rules) unsorted + putStrLn $ + "Day 5, Puzzle 2 solution: " + ++ show (sum $ map getMiddleI fixUnsorted) diff --git a/src/Day05/Puzzle1.hs b/src/Day05/Puzzle1.hs deleted file mode 100644 index 3b8dac3..0000000 --- a/src/Day05/Puzzle1.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# OPTIONS_GHC -Wno-incomplete-patterns #-} - -module Day05.Puzzle1 (day05_1) where - -import Data.List.Split (splitOn) - -isSorted :: [(String, String)] -> [String] -> Bool -isSorted _ [_] = True -isSorted rules (x : xs) = - let after = [p | (p, n) <- rules, n == x] - in not (any (`elem` after) xs) && isSorted rules xs - -getMiddle :: [String] -> String -getMiddle xs = xs !! (length xs `div` 2) - -day05_1 :: IO () -day05_1 = do - contents <- map (splitOn "|") . lines <$> readFile "input/day5.txt" - let rules = [(x, y) | [x, y] <- takeWhile (/= [""]) contents] - updates = concatMap (map (splitOn ",")) . drop 1 $ dropWhile (/= [""]) contents - sorted = filter (isSorted rules) updates - putStrLn $ - "Day 5, Puzzle 1 solution: " - ++ (show :: Int -> String) (sum $ map (read . getMiddle) sorted) diff --git a/src/Day05/Puzzle2.hs b/src/Day05/Puzzle2.hs deleted file mode 100644 index d91ca1c..0000000 --- a/src/Day05/Puzzle2.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# OPTIONS_GHC -Wno-incomplete-patterns #-} - -module Day05.Puzzle2 (day05_2) where - -import Data.List ((\\)) -import Data.List.Split (splitOn) - -isSorted :: [(Int, Int)] -> [Int] -> Bool -isSorted _ [_] = True -isSorted rules (x : xs) = - let after = [p | (p, n) <- rules, n == x] - in not (any (`elem` after) xs) && isSorted rules xs - -getMiddle :: [Int] -> Int -getMiddle xs = xs !! (length xs `div` 2) - -sortOnRules :: [(Int, Int)] -> [Int] -> [Int] -sortOnRules _ [] = [] -sortOnRules rules (x : xs) = sortOnRules rules beforeArray ++ [x] ++ sortOnRules rules afterArray - where - afterArray = xs \\ before - beforeArray = xs \\ afterArray - before = [p | (p, n) <- rules, n == x] - -day05_2 :: IO () -day05_2 = do - contents <- map (splitOn "|") . lines <$> readFile "input/day5.txt" - let rules = [(read x, read y) | [x, y] <- takeWhile (/= [""]) contents] - unsorted = filter (not . isSorted rules) . map (map read) $ concatMap (map (splitOn ",")) . drop 1 $ dropWhile (/= [""]) contents - fixUnsorted = map (sortOnRules rules) unsorted - putStrLn $ - "Day 5, Puzzle 2 solution: " - ++ show (sum $ map getMiddle fixUnsorted) diff --git a/src/Day06/Puzzle2.hs b/src/Day06.hs similarity index 83% rename from src/Day06/Puzzle2.hs rename to src/Day06.hs index e3560ba..cee6426 100644 --- a/src/Day06/Puzzle2.hs +++ b/src/Day06.hs @@ -1,4 +1,8 @@ -module Day06.Puzzle2 (day06_2) where +module Day06 + ( day06_1, + day06_2, + ) +where import Data.List (elemIndex, uncons) import Data.Maybe (fromJust, fromMaybe, isJust) @@ -60,6 +64,12 @@ getNextPosition (x, y) L grid = then getNextPosition (x, y) U grid else (newPos, L) +-- markVisited :: Position -> Char -> Grid -> Grid +-- markVisited (x, y) c grid = +-- let row = grid !! x +-- newRow = take y row ++ [c] ++ drop (y + 1) row +-- in take x grid ++ [newRow] ++ drop (x + 1) grid +-- markVisited :: Position -> Char -> Grid -> Grid markVisited (x, y) c grid = let gridVal = getGridVal (x, y) grid @@ -93,6 +103,21 @@ setGridObstacles startPosition grid = let positions = [(x, y) | x <- [0 .. (length grid - 1)], y <- [0 .. (length (fst . fromJust $ uncons grid) - 1)], (x, y) /= startPosition, getGridVal (x, y) grid == 'X'] in zipWith (`markVisited` '#') positions (replicate (length positions) grid) +day06_1 :: IO () +day06_1 = do + contents <- lines <$> readFile "input/day6.txt" + let (x, y) = + (\a b c d -> fst . fromJust $ uncons $ filter ((>= 0) . fst) [a, b, c, d]) + <$> getStartPosition 'v' + <*> getStartPosition '^' + <*> getStartPosition '<' + <*> getStartPosition '>' + $ contents + direction = fromJust . getDirection $ (contents !! x) !! y + putStrLn $ + "Day 6, Puzzle 1 solution: " + ++ show (1 + (length . concatMap (filter (== 'X')) $ visitGrid (x, y) direction contents)) + day06_2 :: IO () day06_2 = do contents <- lines <$> readFile "input/day6.txt" diff --git a/src/Day06/Puzzle1.hs b/src/Day06/Puzzle1.hs deleted file mode 100644 index cc8cf85..0000000 --- a/src/Day06/Puzzle1.hs +++ /dev/null @@ -1,84 +0,0 @@ -module Day06.Puzzle1 (day06_1) where - -import Data.List (elemIndex, uncons) -import Data.Maybe (fromJust, fromMaybe, isJust) - -type Grid = [String] - -type Position = (Int, Int) - -data Direction = U | R | D | L deriving (Eq) - -getDirection :: Char -> Maybe Direction -getDirection '^' = Just U -getDirection '>' = Just R -getDirection 'v' = Just D -getDirection '<' = Just L -getDirection _ = Nothing - -getStartPosition :: Char -> Grid -> Position -getStartPosition c grid = (x, y) - where - x = fromMaybe (-1) . elemIndex True . map (isJust . elemIndex c) $ grid - y = if x == -1 then -1 else fromMaybe (-1) . elemIndex c $ grid !! x - -getGridVal :: Position -> Grid -> Char -getGridVal (x, y) grid = (grid !! x) !! y - -isInside :: Position -> Grid -> Bool -isInside (x, y) grid = x >= 0 && y >= 0 && x < length grid && y < length (fst . fromJust $ uncons grid) - -getNextPosition :: Position -> Direction -> Grid -> (Position, Direction) -getNextPosition (x, y) U grid = - let newPos = (x - 1, y) - gridVal = getGridVal newPos grid - in if newPos `isInside` grid && gridVal == '#' - then getNextPosition (x, y) R grid - else (newPos, U) -getNextPosition (x, y) R grid = - let newPos = (x, y + 1) - gridVal = getGridVal newPos grid - in if newPos `isInside` grid && gridVal == '#' - then getNextPosition (x, y) D grid - else (newPos, R) -getNextPosition (x, y) D grid = - let newPos = (x + 1, y) - gridVal = getGridVal newPos grid - in if newPos `isInside` grid && gridVal == '#' - then getNextPosition (x, y) L grid - else (newPos, D) -getNextPosition (x, y) L grid = - let newPos = (x, y - 1) - gridVal = getGridVal newPos grid - in if newPos `isInside` grid && gridVal == '#' - then getNextPosition (x, y) U grid - else (newPos, L) - -markVisited :: Position -> Char -> Grid -> Grid -markVisited (x, y) c grid = - let row = grid !! x - newRow = take y row ++ [c] ++ drop (y + 1) row - in take x grid ++ [newRow] ++ drop (x + 1) grid - -visitGrid :: Position -> Direction -> Grid -> Grid -visitGrid (x, y) direction grid = - let newGrid = markVisited (x, y) 'X' grid - (nextPosition, newDirection) = getNextPosition (x, y) direction grid - in if nextPosition `isInside` newGrid - then visitGrid nextPosition newDirection newGrid - else newGrid - -day06_1 :: IO () -day06_1 = do - contents <- lines <$> readFile "input/day6.txt" - let (x, y) = - (\a b c d -> fst . fromJust $ uncons $ filter ((>= 0) . fst) [a, b, c, d]) - <$> getStartPosition 'v' - <*> getStartPosition '^' - <*> getStartPosition '<' - <*> getStartPosition '>' - $ contents - direction = fromJust . getDirection $ (contents !! x) !! y - putStrLn $ - "Day 6, Puzzle 1 solution: " - ++ show (length . concatMap (filter (== 'X')) $ visitGrid (x, y) direction contents) diff --git a/src/Day07.hs b/src/Day07.hs new file mode 100644 index 0000000..c5f9d06 --- /dev/null +++ b/src/Day07.hs @@ -0,0 +1,56 @@ +module Day07 + ( day07_1, + day07_2, + ) +where + +import Data.List (transpose) +import Data.List.Split (splitOn) + +type Equation = (Int, [Int]) + +concatInt :: Int -> Int -> Int +concatInt x y = read $ show x ++ show y + +isSolvable :: Int -> Equation -> Bool +isSolvable cur (result, []) = cur == result +isSolvable cur (result, [x]) = cur + x == result || cur * x == result +isSolvable cur (result, x : y : ys) = + isSolvable (cur + x + y) (result, ys) + || isSolvable ((cur + x) * y) (result, ys) + || isSolvable (cur * x + y) (result, ys) + || isSolvable (cur * x * y) (result, ys) + +isSolvable' :: Int -> Equation -> Bool +isSolvable' cur (result, []) = cur == result +isSolvable' cur (result, [x]) = cur + x == result || cur * x == result || cur `concatInt` x == result +isSolvable' cur (result, x : y : ys) = + isSolvable' (cur + x + y) (result, ys) + || isSolvable' ((cur + x) * y) (result, ys) + || isSolvable' ((cur + x) `concatInt` y) (result, ys) + || isSolvable' (cur * x + y) (result, ys) + || isSolvable' (cur * x * y) (result, ys) + || isSolvable' ((cur * x) `concatInt` y) (result, ys) + || isSolvable' ((cur `concatInt` x) + y) (result, ys) + || isSolvable' ((cur `concatInt` x) * y) (result, ys) + || isSolvable' ((cur `concatInt` x) `concatInt` y) (result, ys) + +day07_1 :: IO () +day07_1 = do + [x, y] <- transpose . map (splitOn ":") . lines <$> readFile "input/day7.txt" + let results = map read x + values = map read <$> map words y + equations = zip results values + putStrLn $ + "Day 7, Puzzle 1 solution: " + ++ show (sum . map fst $ filter (isSolvable 0) equations) + +day07_2 :: IO () +day07_2 = do + [x, y] <- transpose . map (splitOn ":") . lines <$> readFile "input/day7.txt" + let results = map read x + values = map read <$> map words y + equations = zip results values + putStrLn $ + "Day 7, Puzzle 2 solution: " + ++ show (sum . map fst $ filter (isSolvable' 0) equations) diff --git a/src/Day07/Puzzle1.hs b/src/Day07/Puzzle1.hs deleted file mode 100644 index eb55ec3..0000000 --- a/src/Day07/Puzzle1.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Day07.Puzzle1 (day07_1) where - -import Data.List (transpose) -import Data.List.Split (splitOn) - -type Equation = (Int, [Int]) - -isSolvable :: Int -> Equation -> Bool -isSolvable cur (result, []) = cur == result -isSolvable cur (result, [x]) = cur + x == result || cur * x == result -isSolvable cur (result, x : y : ys) = - isSolvable (cur + x + y) (result, ys) - || isSolvable ((cur + x) * y) (result, ys) - || isSolvable (cur * x + y) (result, ys) - || isSolvable (cur * x * y) (result, ys) - -day07_1 :: IO () -day07_1 = do - [x, y] <- transpose . map (splitOn ":") . lines <$> readFile "input/day7.txt" - let results = map read x - values = map read <$> map words y - equations = zip results values - putStrLn $ - "Day 7, Puzzle 1 solution: " - ++ show (sum . map fst $ filter (isSolvable 0) equations) diff --git a/src/Day07/Puzzle2.hs b/src/Day07/Puzzle2.hs deleted file mode 100644 index fccccd0..0000000 --- a/src/Day07/Puzzle2.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Day07.Puzzle2 (day07_2) where - -import Data.List (transpose) -import Data.List.Split (splitOn) - -type Equation = (Int, [Int]) - -concatInt :: Int -> Int -> Int -concatInt x y = read $ show x ++ show y - -isSolvable :: Int -> Equation -> Bool -isSolvable cur (result, []) = cur == result -isSolvable cur (result, [x]) = cur + x == result || cur * x == result || cur `concatInt` x == result -isSolvable cur (result, x : y : ys) = - isSolvable (cur + x + y) (result, ys) - || isSolvable ((cur + x) * y) (result, ys) - || isSolvable ((cur + x) `concatInt` y) (result, ys) - || isSolvable (cur * x + y) (result, ys) - || isSolvable (cur * x * y) (result, ys) - || isSolvable ((cur * x) `concatInt` y) (result, ys) - || isSolvable ((cur `concatInt` x) + y) (result, ys) - || isSolvable ((cur `concatInt` x) * y) (result, ys) - || isSolvable ((cur `concatInt` x) `concatInt` y) (result, ys) - -day07_2 :: IO () -day07_2 = do - [x, y] <- transpose . map (splitOn ":") . lines <$> readFile "input/day7.txt" - let results = map read x - values = map read <$> map words y - equations = zip results values - putStrLn $ - "Day 7, Puzzle 2 solution: " - ++ show (sum . map fst $ filter (isSolvable 0) equations) diff --git a/src/Day08/Puzzle2.hs b/src/Day08.hs similarity index 69% rename from src/Day08/Puzzle2.hs rename to src/Day08.hs index bdebccc..708b4ac 100644 --- a/src/Day08/Puzzle2.hs +++ b/src/Day08.hs @@ -1,4 +1,8 @@ -module Day08.Puzzle2 (day08_2) where +module Day08 + ( day08_1, + day08_2, + ) +where import Control.Applicative import Data.Bifunctor (bimap) @@ -34,6 +38,16 @@ generateCoords c offset = scanl shiftCoords c (repeat offset) getAntinodes :: Antenna -> Antenna -> Int -> Int -> [Coords] getAntinodes a b maxX maxY = + let xa = fst $ coordinates a + ya = snd $ coordinates a + xb = fst $ coordinates b + yb = snd $ coordinates b + in if frequency a /= frequency b || coordinates a == coordinates b + then [] + else filter (\c -> isInside c maxX maxY) [(2 * xa - xb, 2 * ya - yb), (2 * xb - xa, 2 * yb - ya)] + +getAntinodes' :: Antenna -> Antenna -> Int -> Int -> [Coords] +getAntinodes' a b maxX maxY = let xa = fst $ coordinates a ya = snd $ coordinates a xb = fst $ coordinates b @@ -47,11 +61,20 @@ getAntinodes a b maxX maxY = ++ takeWhile (\c -> isInside c maxX maxY) (generateCoords (coordinates a) (distX, distY)) ++ takeWhile (\c -> isInside c maxX maxY) (generateCoords (coordinates b) (-distX, -distY)) +day08_1 :: IO () +day08_1 = do + contents <- lines <$> readFile "input/day8.txt" + let antennas = getAntennas contents + x = length contents + y = length $ fst . fromJust $ uncons contents + antinodes = fromList $ concat [getAntinodes a b x y | a <- antennas, b <- antennas, a /= b, frequency a == frequency b] + putStrLn $ "Day 8, Puzzle 1 solution: " ++ show (length antinodes) + day08_2 :: IO () day08_2 = do contents <- lines <$> readFile "input/day8.txt" let antennas = getAntennas contents x = length contents y = length $ fst . fromJust $ uncons contents - antinodes = fromList $ concat [getAntinodes a b x y | a <- antennas, b <- antennas, a /= b, frequency a == frequency b] + antinodes = fromList $ concat [getAntinodes' a b x y | a <- antennas, b <- antennas, a /= b, frequency a == frequency b] putStrLn $ "Day 8, Puzzle 2 solution: " ++ show (length antinodes) diff --git a/src/Day08/Puzzle1.hs b/src/Day08/Puzzle1.hs deleted file mode 100644 index f8724de..0000000 --- a/src/Day08/Puzzle1.hs +++ /dev/null @@ -1,46 +0,0 @@ -module Day08.Puzzle1 (day08_1) where - -import Control.Applicative -import Data.List (uncons) -import Data.Maybe (fromJust) -import qualified Data.Set as Set - -type Freq = Char - -type Coords = (Int, Int) - -data Antenna = Antenna - { frequency :: Freq, - coordinates :: Coords - } - deriving (Show, Eq) - -readAntenna :: Freq -> Coords -> Antenna -readAntenna freq coords = Antenna {frequency = freq, coordinates = coords} - -getAntennas :: [String] -> [Antenna] -getAntennas grid = concat . getZipList $ getAntennasRow <$> ZipList [0 ..] <*> ZipList grid - where - getAntennasRow n row = [readAntenna x (n, y) | (x, y) <- zip row [0 ..], x /= '.'] - -isInside :: Coords -> Int -> Int -> Bool -isInside c x y = fst c >= 0 && fst c < x && snd c >= 0 && snd c < y - -getAntinodes :: Antenna -> Antenna -> Int -> Int -> [Coords] -getAntinodes a b maxX maxY = - let xa = fst $ coordinates a - ya = snd $ coordinates a - xb = fst $ coordinates b - yb = snd $ coordinates b - in if frequency a /= frequency b || coordinates a == coordinates b - then [] - else filter (\c -> isInside c maxX maxY) [(2 * xa - xb, 2 * ya - yb), (2 * xb - xa, 2 * yb - ya)] - -day08_1 :: IO () -day08_1 = do - contents <- lines <$> readFile "input/day8.txt" - let antennas = getAntennas contents - x = length contents - y = length $ fst . fromJust $ uncons contents - antinodes = Set.fromList $ concat [getAntinodes a b x y | a <- antennas, b <- antennas, a /= b, frequency a == frequency b] - putStrLn $ "Day 8, Puzzle 1 solution: " ++ show (length antinodes) diff --git a/src/Day09/Puzzle2.hs b/src/Day09.hs similarity index 63% rename from src/Day09/Puzzle2.hs rename to src/Day09.hs index 0a79423..ce8c8f0 100644 --- a/src/Day09/Puzzle2.hs +++ b/src/Day09.hs @@ -1,21 +1,41 @@ {-# OPTIONS_GHC -Wno-incomplete-patterns #-} -module Day09.Puzzle2 (day09_2) where +module Day09 + ( day09_1, + day09_2, + ) +where +import Control.Applicative import Data.Char (digitToInt) import qualified Data.Foldable as F import Data.Function (on) import Data.List (groupBy, intersperse) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromJust, fromMaybe) import qualified Data.Sequence as S type DiskElem = (Int, Int) -parseDiskMap :: [Int] -> S.Seq DiskElem +parseDiskMap :: [Int] -> S.Seq Int parseDiskMap xs = + let values = intersperse (-1) [0 ..] + in S.fromList . concat . getZipList $ replicate <$> ZipList xs <*> ZipList values + +parseDiskMap' :: [Int] -> S.Seq DiskElem +parseDiskMap' xs = let values = intersperse (-1) [0 ..] in S.fromList $ zip values xs +compact :: S.Seq Int -> S.Seq Int +compact xs + | fileIndex == -1 = xs + | otherwise = S.filter (/= -1) $ startDisk S.>< (compact . S.insertAt 0 fileVal . S.deleteAt 0 $ S.deleteAt fileIndex endDisk) + where + spaceIndex = fromJust $ S.elemIndexL (-1) xs + (startDisk, endDisk) = S.splitAt spaceIndex xs + fileIndex = fromMaybe (-1) (S.findIndexR (/= -1) endDisk) + fileVal = S.index endDisk fileIndex + isSpaceEnough :: Int -> DiskElem -> Bool isSpaceEnough n (-1, l) = l >= n isSpaceEnough _ _ = False @@ -60,12 +80,23 @@ tuplesToIntList disk = in concatMap (\x -> replicate (snd x) (fst x)) listDisk checksum :: [Int] -> Int -checksum xs = sum $ zipWith (*) (maskMinus1 xs) [0 ..] +checksum xs = sum $ zipWith (*) xs [0 ..] + +checksum' :: [Int] -> Int +checksum' xs = sum $ zipWith (*) (maskMinus1 xs) [0 ..] + +day09_1 :: IO () +day09_1 = do + contents <- init <$> readFile "input/day9.txt" + let diskMap = map digitToInt contents + putStrLn $ + "Day 9, Puzzle 1 solution: " + ++ show (checksum . F.toList . compact $ parseDiskMap diskMap) day09_2 :: IO () day09_2 = do contents <- init <$> readFile "input/day9.txt" - let disk = parseDiskMap $ map digitToInt contents + let disk = parseDiskMap' $ map digitToInt contents i = fromMaybe (-1) $ S.findIndexR (\x -> fst x /= -1) disk compactedDisk = tuplesToIntList $ S.filter (\x -> snd x > 0) $ compactFiles i disk - putStrLn $ "Day 9, Puzzle 2 solution: " ++ show (checksum compactedDisk) + putStrLn $ "Day 9, Puzzle 2 solution: " ++ show (checksum' compactedDisk) diff --git a/src/Day09/Puzzle1.hs b/src/Day09/Puzzle1.hs deleted file mode 100644 index da50868..0000000 --- a/src/Day09/Puzzle1.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Day09.Puzzle1 (day09_1) where - -import Control.Applicative -import Data.Char (digitToInt) -import qualified Data.Foldable as F -import Data.List (intersperse) -import Data.Maybe (fromJust, fromMaybe) -import qualified Data.Sequence as S - -parseDiskMap :: [Int] -> S.Seq Int -parseDiskMap xs = - let values = intersperse (-1) [0 ..] - in S.fromList . concat . getZipList $ replicate <$> ZipList xs <*> ZipList values - -compact :: S.Seq Int -> S.Seq Int -compact xs - | fileIndex == -1 = xs - | otherwise = S.filter (/= -1) $ startDisk S.>< (compact . S.insertAt 0 fileVal . S.deleteAt 0 $ S.deleteAt fileIndex endDisk) - where - spaceIndex = fromJust $ S.elemIndexL (-1) xs - (startDisk, endDisk) = S.splitAt spaceIndex xs - fileIndex = fromMaybe (-1) (S.findIndexR (/= -1) endDisk) - fileVal = S.index endDisk fileIndex - -checksum :: [Int] -> Int -checksum xs = sum $ zipWith (*) xs [0 ..] - -day09_1 :: IO () -day09_1 = do - contents <- init <$> readFile "input/day9.txt" - let diskMap = map digitToInt contents - putStrLn $ - "Day 9, Puzzle 1 solution: " - ++ show (checksum . F.toList . compact $ parseDiskMap diskMap) diff --git a/src/Day10/Puzzle2.hs b/src/Day10.hs similarity index 67% rename from src/Day10/Puzzle2.hs rename to src/Day10.hs index 82deec7..0dbcdf6 100644 --- a/src/Day10/Puzzle2.hs +++ b/src/Day10.hs @@ -1,4 +1,8 @@ -module Day10.Puzzle2 (day10_2) where +module Day10 + ( day10_1, + day10_2, + ) +where import qualified Data.Array as A import Data.Char (digitToInt) @@ -19,6 +23,15 @@ findAllPaths graph start end path = do then return path' else findAllPaths graph node end path' +day10_1 :: IO () +day10_1 = do + contents <- lines <$> readFile "input/day10.txt" + let trailMap = A.listArray ((0, 0), (52, 52)) $ map digitToInt $ concat contents + trailGraph = Graph {edges = M.fromList [(k, adjacent trailMap k (52, 52)) | k <- A.indices trailMap]} + startList = map fst . filter (\(_, y) -> y == 0) $ A.assocs trailMap + endList = map fst . filter (\(_, y) -> y == 9) $ A.assocs trailMap + putStrLn $ "Day 10, Puzzle 1 solution: " ++ show (length $ filter (not . null) [findAllPaths trailGraph x y [x] | x <- startList, y <- endList]) + day10_2 :: IO () day10_2 = do contents <- lines <$> readFile "input/day10.txt" diff --git a/src/Day10/Puzzle1.hs b/src/Day10/Puzzle1.hs deleted file mode 100644 index 0c49c50..0000000 --- a/src/Day10/Puzzle1.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Day10.Puzzle1 (day10_1) where - -import qualified Data.Array as A -import Data.Char (digitToInt) -import qualified Data.HashMap.Strict as M - -type Coords = (Int, Int) - -newtype Graph a = Graph {edges :: M.HashMap a [a]} deriving (Show) - -adjacent :: A.Array Coords Int -> Coords -> Coords -> [Coords] -adjacent array (i, j) (maxI, maxJ) = [(a, b) | (a, b) <- [(i, j + 1), (i, j - 1), (i + 1, j), (i - 1, j)], a >= 0, b >= 0, a <= maxI, b <= maxJ, array A.! (a, b) - array A.! (i, j) == 1] - -findAllPaths :: Graph Coords -> Coords -> Coords -> [Coords] -> [[Coords]] -findAllPaths graph start end path = do - node <- edges graph M.! start - let path' = path ++ [node] - if node == end - then return path' - else findAllPaths graph node end path' - -day10_1 :: IO () -day10_1 = do - contents <- lines <$> readFile "input/day10.txt" - let trailMap = A.listArray ((0, 0), (52, 52)) $ map digitToInt $ concat contents - trailGraph = Graph {edges = M.fromList [(k, adjacent trailMap k (52, 52)) | k <- A.indices trailMap]} - startList = map fst . filter (\(_, y) -> y == 0) $ A.assocs trailMap - endList = map fst . filter (\(_, y) -> y == 9) $ A.assocs trailMap - putStrLn $ "Day 10, Puzzle 1 solution: " ++ show (length $ filter (not . null) [findAllPaths trailGraph x y [x] | x <- startList, y <- endList]) diff --git a/src/Day11/Puzzle1.hs b/src/Day11.hs similarity index 70% rename from src/Day11/Puzzle1.hs rename to src/Day11.hs index 876875e..6baaf0d 100644 --- a/src/Day11/Puzzle1.hs +++ b/src/Day11.hs @@ -1,4 +1,8 @@ -module Day11.Puzzle1 (day11_1) where +module Day11 + ( day11_1, + day11_2, + ) +where import qualified Data.Map.Strict as M @@ -21,3 +25,10 @@ day11_1 = do putStrLn $ "Day 11, Puzzle 1 solution: " ++ show (M.foldl (+) 0 $ blink 25 contents) + +day11_2 :: IO () +day11_2 = do + contents <- M.fromListWith (+) . flip zip (repeat 1) . map read . words <$> readFile "input/day11.txt" + putStrLn $ + "Day 11, Puzzle 2 solution: " + ++ show (M.foldl (+) 0 $ blink 75 contents) diff --git a/src/Day11/Puzzle2.hs b/src/Day11/Puzzle2.hs deleted file mode 100644 index df2d527..0000000 --- a/src/Day11/Puzzle2.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Day11.Puzzle2 (day11_2) where - -import qualified Data.Map.Strict as M - -blinkStone :: (Int, Int) -> [(Int, Int)] -blinkStone (0, n) = [(1, n)] -blinkStone (s, n) = - let ss = show s - nDigit = length ss - in if even nDigit - then zip (map read [take (nDigit `div` 2) ss, drop (nDigit `div` 2) ss]) [n, n] - else [(s * 2024, n)] - -blink :: Int -> M.Map Int Int -> M.Map Int Int -blink 0 m = m -blink n m = blink (n - 1) $ M.fromListWith (+) $ concatMap blinkStone $ M.toList m - -day11_2 :: IO () -day11_2 = do - contents <- M.fromListWith (+) . flip zip (repeat 1) . map read . words <$> readFile "input/day11.txt" - putStrLn $ - "Day 11, Puzzle 2 solution: " - ++ show (M.foldl (+) 0 $ blink 75 contents) diff --git a/src/Day12/Puzzle1.hs b/src/Day12.hs similarity index 97% rename from src/Day12/Puzzle1.hs rename to src/Day12.hs index acfaeb0..8a97c0c 100644 --- a/src/Day12/Puzzle1.hs +++ b/src/Day12.hs @@ -1,4 +1,4 @@ -module Day12.Puzzle1 (day12_1) where +module Day12 (day12_1) where import Data.Foldable (toList) import Data.Graph (Tree, Vertex, graphFromEdges, scc) diff --git a/src/Day13/Puzzle2.hs b/src/Day13.hs similarity index 66% rename from src/Day13/Puzzle2.hs rename to src/Day13.hs index c8599ca..cf72d51 100644 --- a/src/Day13/Puzzle2.hs +++ b/src/Day13.hs @@ -1,6 +1,10 @@ {-# OPTIONS_GHC -Wno-type-defaults #-} -module Day13.Puzzle2 (day13_2) where +module Day13 + ( day13_1, + day13_2, + ) +where import Data.Char (isDigit) import Data.Either (fromRight) @@ -18,8 +22,15 @@ multRes :: (Num a) => [a] -> [a] multRes [x, y, z] = [x, y, z + 10000000000000] multRes xs = xs -getMatrix :: (Num a, Read a) => String -> Matrix a +getMatrix :: (Read a) => String -> Matrix a getMatrix s = + let nValues = map (map read . splitOn ",") . splitOn ":" . drop 1 $ filter (\x -> isDigit x || x == ',' || x == ':') s + eq1 = map (fst . fromJust . uncons) nValues + eq2 = map last nValues + in fromLists [eq1, eq2] + +getMatrix' :: (Num a, Read a) => String -> Matrix a +getMatrix' s = let nValues = map (map read . splitOn ",") . splitOn ":" . drop 1 $ filter (\x -> isDigit x || x == ',' || x == ':') s eq1 = multRes $ map (fst . fromJust . uncons) nValues eq2 = multRes $ map last nValues @@ -37,11 +48,20 @@ cost :: [Int] -> Int cost [x, y] = 3 * x + y cost _ = 0 -day13_2 :: IO () -day13_2 = do +day13_1 :: IO () +day13_1 = do contents <- map concat . chunksOf 4 . lines <$> readFile "input/day13.txt" let eqSystems = map getMatrix contents solutions = (map . map) round $ mapMaybe solve eqSystems + putStrLn $ + "Day 13, Puzzle 1 solution: " + ++ show (sum $ map cost solutions) + +day13_2 :: IO () +day13_2 = do + contents <- map concat . chunksOf 4 . lines <$> readFile "input/day13.txt" + let eqSystems = map getMatrix' contents + solutions = (map . map) round $ mapMaybe solve eqSystems putStrLn $ "Day 13, Puzzle 2 solution: " ++ show (sum $ map cost solutions) diff --git a/src/Day13/Puzzle1.hs b/src/Day13/Puzzle1.hs deleted file mode 100644 index ac26e16..0000000 --- a/src/Day13/Puzzle1.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# OPTIONS_GHC -Wno-type-defaults #-} - -module Day13.Puzzle1 (day13_1) where - -import Data.Char (isDigit) -import Data.Either (fromRight) -import Data.List (uncons) -import Data.List.Split (chunksOf, splitOn) -import Data.Matrix (Matrix, fromLists, rref, toList, zero) -import Data.Maybe (fromJust, mapMaybe) - -isAlmostInt :: (RealFrac a) => a -> Bool -isAlmostInt x = - let diff = x - fromInteger (round x) - in abs diff < 0.001 - -getMatrix :: (Read a) => String -> Matrix a -getMatrix s = - let nValues = map (map read . splitOn ",") . splitOn ":" . drop 1 $ filter (\x -> isDigit x || x == ',' || x == ':') s - eq1 = map (fst . fromJust . uncons) nValues - eq2 = map last nValues - in fromLists [eq1, eq2] - -solve :: (RealFrac a) => Matrix a -> Maybe [a] -solve eqSystem = - let rowEchelonList = toList . fromRight (zero 1 1) $ rref eqSystem - solutions = [rowEchelonList !! 2, rowEchelonList !! 5] - in if all isAlmostInt solutions - then Just solutions - else Nothing - -cost :: [Int] -> Int -cost [x, y] = 3 * x + y -cost _ = 0 - -day13_1 :: IO () -day13_1 = do - contents <- map concat . chunksOf 4 . lines <$> readFile "input/day13.txt" - let eqSystems = map getMatrix contents - solutions = (map . map) round $ mapMaybe solve eqSystems - putStrLn $ - "Day 13, Puzzle 1 solution: " - ++ show (sum $ map cost solutions) diff --git a/src/Day14/Puzzle1.hs b/src/Day14.hs similarity index 70% rename from src/Day14/Puzzle1.hs rename to src/Day14.hs index 19a1d66..d8b4a32 100644 --- a/src/Day14/Puzzle1.hs +++ b/src/Day14.hs @@ -1,8 +1,13 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module Day14.Puzzle1 (day14_1) where +module Day14 + ( day14_1, + day14_2, + ) +where import Data.Char (isDigit) +import Data.List (nub) import Data.List.Split (splitOn) type Position = (Int, Int) @@ -25,6 +30,12 @@ moveRobot n r = (vx, vy) = snd r in moveRobot (n - 1) (((px + vx) `mod` 101, (py + vy) `mod` 103), (vx, vy)) +moveRobot' :: Robot -> Robot +moveRobot' r = + let (px, py) = fst r + (vx, vy) = snd r + in (((px + vx) `mod` 101, (py + vy) `mod` 103), (vx, vy)) + quadrant :: Robot -> Int quadrant r | fst p `elem` [0 .. 49] @@ -43,6 +54,14 @@ quadrant r where p = fst r +findChristmasTree :: Int -> [Robot] -> Int +findChristmasTree n rs = + let rs' = map moveRobot' rs + positions = map fst rs' + in if positions == nub positions + then n + else findChristmasTree (n + 1) rs' + day14_1 :: IO () day14_1 = do contents <- lines <$> readFile "input/day14.txt" @@ -55,3 +74,11 @@ day14_1 = do putStrLn $ "Day 14, Puzzle 1 solution: " ++ show (firstQ * secondQ * thirdQ * fourthQ) + +day14_2 :: IO () +day14_2 = do + contents <- lines <$> readFile "input/day14.txt" + let robots = map readRobot contents + putStrLn $ + "Day 14, Puzzle 2 solution: " + ++ show (findChristmasTree 1 robots) diff --git a/src/Day14/Puzzle2.hs b/src/Day14/Puzzle2.hs deleted file mode 100644 index 52b0394..0000000 --- a/src/Day14/Puzzle2.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -module Day14.Puzzle2 (day14_2) where - -import Data.Char (isDigit) -import Data.List (nub) -import Data.List.Split (splitOn) - -type Position = (Int, Int) - -type Velocity = (Int, Int) - -type Robot = (Position, Velocity) - -readRobot :: String -> Robot -readRobot s = - let [ps, vs] = splitOn " " s - [px, py] = map read . splitOn "," $ filter (\x -> isDigit x || x == ',' || x == '-') ps - [vx, vy] = map read . splitOn "," $ filter (\x -> isDigit x || x == ',' || x == '-') vs - in ((px, py), (vx, vy)) - -moveRobot :: Robot -> Robot -moveRobot r = - let (px, py) = fst r - (vx, vy) = snd r - in (((px + vx) `mod` 101, (py + vy) `mod` 103), (vx, vy)) - -findChristmasTree :: Int -> [Robot] -> Int -findChristmasTree n rs = - let rs' = map moveRobot rs - positions = map fst rs' - in if positions == nub positions - then n - else findChristmasTree (n + 1) rs' - -day14_2 :: IO () -day14_2 = do - contents <- lines <$> readFile "input/day14.txt" - let robots = map readRobot contents - putStrLn $ - "Day 14, Puzzle 2 solution: " - ++ show (findChristmasTree 1 robots) diff --git a/src/Day15/Puzzle1.hs b/src/Day15.hs similarity index 99% rename from src/Day15/Puzzle1.hs rename to src/Day15.hs index 2e08e95..68df398 100644 --- a/src/Day15/Puzzle1.hs +++ b/src/Day15.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module Day15.Puzzle1 (day15_1) where +module Day15 (day15_1) where import Data.List (elemIndex, elemIndices, transpose, uncons) import Data.List.Split (splitOn) diff --git a/src/Day17/Puzzle1.hs b/src/Day17.hs similarity index 99% rename from src/Day17/Puzzle1.hs rename to src/Day17.hs index a61b04e..cdd8a1d 100644 --- a/src/Day17/Puzzle1.hs +++ b/src/Day17.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module Day17.Puzzle1 (day17_1) where +module Day17 (day17_1) where import Control.Monad.State import Data.Bits diff --git a/src/Day18/Puzzle2.hs b/src/Day18.hs similarity index 87% rename from src/Day18/Puzzle2.hs rename to src/Day18.hs index 56be3c1..5bb0196 100644 --- a/src/Day18/Puzzle2.hs +++ b/src/Day18.hs @@ -1,6 +1,10 @@ {-# OPTIONS_GHC -Wno-incomplete-patterns #-} -module Day18.Puzzle2 (day18_2) where +module Day18 + ( day18_1, + day18_2, + ) +where import qualified Data.Array as A import qualified Data.HashMap.Strict as M @@ -32,7 +36,6 @@ data DijkstraState = DijkstraState { unvisited :: PQ.PSQ Coords (Distance Int), distances :: M.HashMap Coords (Distance Int) } - deriving (Show) updateDistances :: M.HashMap Coords (Distance Int) -> [Coords] -> Distance Int -> M.HashMap Coords (Distance Int) updateDistances dists [] _ = dists @@ -82,6 +85,15 @@ findFirstBlocker memory (c : cs) start end = then c else findFirstBlocker memory' cs start end +day18_1 :: IO () +day18_1 = do + contents <- map (splitOn ",") . lines <$> readFile "input/day18.txt" + let memory = A.listArray ((0, 0), (70, 70)) $ replicate 5041 '.' + coords = take 1024 [(read x, read y) | (x : y : _) <- contents] + memory' = corruptMemory memory coords + memoryGraph = Graph {edges = M.fromList [(k, adjacent memory' k (70, 70)) | k <- A.indices memory']} + putStrLn $ "Day 18, Puzzle 1 solution: " ++ show (findShortestPath memoryGraph (0, 0) (70, 70)) + day18_2 :: IO () day18_2 = do contents <- map (splitOn ",") . lines <$> readFile "input/day18.txt" diff --git a/src/Day18/Puzzle1.hs b/src/Day18/Puzzle1.hs deleted file mode 100644 index 36ac115..0000000 --- a/src/Day18/Puzzle1.hs +++ /dev/null @@ -1,81 +0,0 @@ -module Day18.Puzzle1 (day18_1) where - -import qualified Data.Array as A -import qualified Data.HashMap.Strict as M -import Data.List.Split (splitOn) -import Data.Maybe (fromJust) -import qualified Data.PSQueue as PQ - -type Coords = (Int, Int) - -newtype Graph = Graph {edges :: M.HashMap Coords [Coords]} deriving (Show) - -data Distance a = Dist a | Infinity deriving (Eq) - -instance (Ord a) => Ord (Distance a) where - Infinity <= Infinity = True - Infinity <= Dist _ = False - Dist _ <= Infinity = True - Dist x <= Dist y = x <= y - -instance (Show a) => Show (Distance a) where - show Infinity = "Infinity" - show (Dist x) = show x - -addDistance :: (Num a) => Distance a -> Distance a -> Distance a -addDistance (Dist x) (Dist y) = Dist (x + y) -addDistance _ _ = Infinity - -data DijkstraState = DijkstraState - { unvisited :: PQ.PSQ Coords (Distance Int), - distances :: M.HashMap Coords (Distance Int) - } - -updateDistances :: M.HashMap Coords (Distance Int) -> [Coords] -> Distance Int -> M.HashMap Coords (Distance Int) -updateDistances dists [] _ = dists -updateDistances dists (n : nodes) startD = - updateDistances (M.adjust (const startD) n dists) nodes startD - -visit :: PQ.PSQ Coords (Distance Int) -> Coords -> [Coords] -> Distance Int -> PQ.PSQ Coords (Distance Int) -visit us node [] _ = PQ.delete node us -visit us node (e : es) dist = visit (PQ.adjust (const dist) e us) node es dist - -visitNode :: DijkstraState -> Graph -> Coords -> Distance Int -> DijkstraState -visitNode state graph node d = - let es = edges graph M.! node - ds = updateDistances (distances state) es d - us = visit (unvisited state) node es d - in state {unvisited = us, distances = ds} - -findShortestPath :: Graph -> Coords -> Coords -> Distance Int -findShortestPath graph start end = - let nodesDist = (start PQ.:-> Dist 0) : [k PQ.:-> Infinity | k <- M.keys $ edges graph, k /= start] - dists = (start, Dist 0) : [(k, Infinity) | k <- M.keys $ edges graph, k /= start] - initialState = DijkstraState {unvisited = PQ.fromList nodesDist, distances = M.fromList dists} - in dijkstra initialState - where - dijkstra s = - let nd = fromJust $ PQ.findMin (unvisited s) - n = PQ.key nd - d = PQ.prio nd - in if n == end - then d - else - if d == Infinity - then Infinity - else dijkstra $ visitNode s graph n (addDistance d (Dist 1)) - -adjacent :: A.Array Coords Char -> Coords -> Coords -> [Coords] -adjacent array (i, j) (maxI, maxJ) = [(a, b) | (a, b) <- [(i, j + 1), (i, j - 1), (i + 1, j), (i - 1, j)], a >= 0, b >= 0, a <= maxI, b <= maxJ, array A.! (a, b) /= '#'] - -corruptMemory :: A.Array Coords Char -> [Coords] -> A.Array Coords Char -corruptMemory = foldl (\a b -> a A.// [(b, '#')]) - -day18_1 :: IO () -day18_1 = do - contents <- map (splitOn ",") . lines <$> readFile "input/day18.txt" - let memory = A.listArray ((0, 0), (70, 70)) $ replicate 5041 '.' - coords = take 1024 [(read x, read y) | (x : y : _) <- contents] - memory' = corruptMemory memory coords - memoryGraph = Graph {edges = M.fromList [(k, adjacent memory' k (70, 70)) | k <- A.indices memory']} - putStrLn $ "Day 18, Puzzle 1 solution: " ++ show (findShortestPath memoryGraph (0, 0) (70, 70)) diff --git a/src/Day19/Puzzle1.hs b/src/Day19.hs similarity index 96% rename from src/Day19/Puzzle1.hs rename to src/Day19.hs index 0da8698..2dec97b 100644 --- a/src/Day19/Puzzle1.hs +++ b/src/Day19.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module Day19.Puzzle1 (day19_1) where +module Day19 (day19_1) where import Control.Monad (guard) import Data.List (isPrefixOf) diff --git a/src/Main.hs b/src/Main.hs index 064cd75..8754d9b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,37 +1,23 @@ module Main (main) where -import Day01.Puzzle1 -import Day01.Puzzle2 -import Day02.Puzzle1 -import Day02.Puzzle2 -import Day03.Puzzle1 -import Day03.Puzzle2 -import Day04.Puzzle1 -import Day04.Puzzle2 -import Day05.Puzzle1 -import Day05.Puzzle2 -import Day06.Puzzle1 -import Day06.Puzzle2 -import Day07.Puzzle1 -import Day07.Puzzle2 -import Day08.Puzzle1 -import Day08.Puzzle2 -import Day09.Puzzle1 -import Day09.Puzzle2 -import Day10.Puzzle1 -import Day10.Puzzle2 -import Day11.Puzzle1 -import Day11.Puzzle2 -import Day12.Puzzle1 -import Day13.Puzzle1 -import Day13.Puzzle2 -import Day14.Puzzle1 -import Day14.Puzzle2 -import Day15.Puzzle1 -import Day17.Puzzle1 -import Day18.Puzzle1 -import Day18.Puzzle2 -import Day19.Puzzle1 +import Day01 (day01_1, day01_2) +import Day02 (day02_1, day02_2) +import Day03 (day03_1, day03_2) +import Day04 (day04_1, day04_2) +import Day05 (day05_1, day05_2) +import Day06 (day06_1, day06_2) +import Day07 (day07_1, day07_2) +import Day08 (day08_1, day08_2) +import Day09 (day09_1, day09_2) +import Day10 (day10_1, day10_2) +import Day11 (day11_1, day11_2) +import Day12 (day12_1) +import Day13 (day13_1, day13_2) +import Day14 (day14_1, day14_2) +import Day15 (day15_1) +import Day17 (day17_1) +import Day18 (day18_1, day18_2) +import Day19 (day19_1) import System.Environment (getArgs) main :: IO () @@ -40,34 +26,76 @@ main = do case args of "1" : "1" : _ -> day01_1 "1" : "2" : _ -> day01_2 + "1" : _ -> do + day01_1 + day01_2 "2" : "1" : _ -> day02_1 "2" : "2" : _ -> day02_2 + "2" : _ -> do + day02_1 + day02_2 "3" : "1" : _ -> day03_1 "3" : "2" : _ -> day03_2 + "3" : _ -> do + day03_1 + day03_2 "4" : "1" : _ -> day04_1 "4" : "2" : _ -> day04_2 + "4" : _ -> do + day04_1 + day04_2 "5" : "1" : _ -> day05_1 "5" : "2" : _ -> day05_2 + "5" : _ -> do + day05_1 + day05_2 "6" : "1" : _ -> day06_1 "6" : "2" : _ -> day06_2 + "6" : _ -> do + day06_1 + day06_2 "7" : "1" : _ -> day07_1 "7" : "2" : _ -> day07_2 + "7" : _ -> do + day07_1 + day07_2 "8" : "1" : _ -> day08_1 "8" : "2" : _ -> day08_2 + "8" : _ -> do + day08_1 + day08_2 "9" : "1" : _ -> day09_1 "9" : "2" : _ -> day09_2 + "9" : _ -> do + day09_1 + day09_2 "10" : "1" : _ -> day10_1 "10" : "2" : _ -> day10_2 + "10" : _ -> do + day10_1 + day10_2 "11" : "1" : _ -> day11_1 "11" : "2" : _ -> day11_2 + "11" : _ -> do + day11_1 + day11_2 "12" : "1" : _ -> day12_1 "13" : "1" : _ -> day13_1 "13" : "2" : _ -> day13_2 + "13" : _ -> do + day13_1 + day13_2 "14" : "1" : _ -> day14_1 "14" : "2" : _ -> day14_2 + "14" : _ -> do + day14_1 + day14_2 "15" : "1" : _ -> day15_1 "17" : "1" : _ -> day17_1 "18" : "1" : _ -> day18_1 "18" : "2" : _ -> day18_2 + "18" : _ -> do + day18_1 + day18_2 "19" : "1" : _ -> day19_1 _ -> error "Not implemented"