Refactor code

adventofcode2024.cabal

@@ -37,35 +37,21 @@ executable adventofcode2024
                        -Wpartial-fields
                        -Wredundant-constraints
   other-modules:
-    Day01.Puzzle1
+    Day01
-    Day01.Puzzle2
+    Day02
-    Day02.Puzzle1
+    Day03
-    Day02.Puzzle2
+    Day04
-    Day03.Puzzle1
+    Day05
-    Day03.Puzzle2
+    Day06
-    Day04.Puzzle1
+    Day07
-    Day04.Puzzle2
+    Day08
-    Day05.Puzzle1
+    Day09
-    Day05.Puzzle2
+    Day10
-    Day06.Puzzle1
+    Day11
-    Day06.Puzzle2
+    Day12
-    Day07.Puzzle1
+    Day13
-    Day07.Puzzle2
+    Day14
-    Day08.Puzzle1
+    Day15
-    Day08.Puzzle2
+    Day17
-    Day09.Puzzle1
+    Day18
-    Day09.Puzzle2
+    Day19
-    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

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"

src/Day01/Puzzle1.hs

@@ -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)

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"

src/Day02/Puzzle1.hs

@@ -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)

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"

src/Day03/Puzzle1.hs

@@ -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)

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

src/Day04/Puzzle2.hs

@@ -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

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)

src/Day05/Puzzle1.hs

@@ -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)

src/Day05/Puzzle2.hs

@@ -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)

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"

src/Day06/Puzzle1.hs

@@ -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)

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)

src/Day07/Puzzle1.hs

@@ -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)

src/Day07/Puzzle2.hs

@@ -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)

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)

src/Day08/Puzzle1.hs

@@ -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)

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)

src/Day09/Puzzle1.hs

@@ -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)

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"

src/Day10/Puzzle1.hs

@@ -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])

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)

src/Day11/Puzzle2.hs

@@ -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)

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)

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_1 :: IO ()
-day13_2 = do
+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)

src/Day13/Puzzle1.hs

@@ -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)

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)

src/Day14/Puzzle2.hs

@@ -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)

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)

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

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"

src/Day18/Puzzle1.hs

@@ -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))

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)

src/Main.hs

@@ -1,37 +1,23 @@
 module Main (main) where
 
-import Day01.Puzzle1
+import Day01 (day01_1, day01_2)
-import Day01.Puzzle2
+import Day02 (day02_1, day02_2)
-import Day02.Puzzle1
+import Day03 (day03_1, day03_2)
-import Day02.Puzzle2
+import Day04 (day04_1, day04_2)
-import Day03.Puzzle1
+import Day05 (day05_1, day05_2)
-import Day03.Puzzle2
+import Day06 (day06_1, day06_2)
-import Day04.Puzzle1
+import Day07 (day07_1, day07_2)
-import Day04.Puzzle2
+import Day08 (day08_1, day08_2)
-import Day05.Puzzle1
+import Day09 (day09_1, day09_2)
-import Day05.Puzzle2
+import Day10 (day10_1, day10_2)
-import Day06.Puzzle1
+import Day11 (day11_1, day11_2)
-import Day06.Puzzle2
+import Day12 (day12_1)
-import Day07.Puzzle1
+import Day13 (day13_1, day13_2)
-import Day07.Puzzle2
+import Day14 (day14_1, day14_2)
-import Day08.Puzzle1
+import Day15 (day15_1)
-import Day08.Puzzle2
+import Day17 (day17_1)
-import Day09.Puzzle1
+import Day18 (day18_1, day18_2)
-import Day09.Puzzle2
+import Day19 (day19_1)
-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 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"