Refactor code
This commit is contained in:
parent
5c90ad8c8f
commit
cff92ce34f
GPG Key ID:
981A2B2A3BBF5514
@ -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
|
||||
|
||||
@ -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"
|
||||
@ -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)
|
||||
@ -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"
|
||||
@ -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)
|
||||
@ -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"
|
||||
@ -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)
|
||||
@ -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
|
||||
@ -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
|
||||
56
src/Day05.hs
Normal file
56
src/Day05.hs
Normal file
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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"
|
||||
@ -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)
|
||||
56
src/Day07.hs
Normal file
56
src/Day07.hs
Normal file
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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"
|
||||
@ -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])
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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
|
||||
@ -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"
|
||||
@ -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))
|
||||
@ -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)
|
||||
92
src/Main.hs
92
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"
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user