fuxino/AdventOfCode2024
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix code style with ormolu

Browse Source
This commit is contained in:
daniele 2024-12-15 10:31:53 +01:00
parent 7b40fc7814
commit ba73f8c638
Signed by: fuxino
GPG Key ID: 981A2B2A3BBF5514
25 changed files with 538 additions and 418 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Day1/Puzzle1.hs
View File

@ -2,14 +2,15 @@
module Day1.Puzzle1 (day1_1) where module Day1.Puzzle1 (day1_1) where
import Data.List (transpose, sort) import Data.List (sort, transpose)
listDistance :: [Int] -> [Int] -> Int listDistance :: [Int] -> [Int] -> Int
listDistance xs ys = sum $ map abs $ zipWith (-) (sort xs) (sort ys) listDistance xs ys = sum $ map abs $ zipWith (-) (sort xs) (sort ys)
day1_1 :: IO () day1_1 :: IO ()
day1_1 = do day1_1 = do
contents <- lines <$> readFile "input/day1.txt" contents <- lines <$> readFile "input/day1.txt"
let [x, y] = transpose $ map read . words <$> contents let [x, y] = transpose $ map read . words <$> contents
putStrLn $ "Day 1, Puzzle 1 solution: " putStrLn $
++ show (listDistance x y) "Day 1, Puzzle 1 solution: "
++ show (listDistance x y)

16
src/Day1/Puzzle2.hs
View File

@ -2,16 +2,18 @@
module Day1.Puzzle2 (day1_2) where module Day1.Puzzle2 (day1_2) where
import Data.List (transpose, sort, group, uncons) import Data.List (group, sort, transpose, uncons)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
similarityScore :: [Int] -> [Int] -> Int similarityScore :: [Int] -> [Int] -> Int
similarityScore xs ys = let elemsY = [ (fst . fromJust $ uncons y, length y) | y <- (group . sort) ys ] similarityScore xs ys =
in sum [ x * snd y | x <- xs, y <- elemsY, x == fst y ] let elemsY = [(fst . fromJust $ uncons y, length y) | y <- (group . sort) ys]
in sum [x * snd y | x <- xs, y <- elemsY, x == fst y]
day1_2 :: IO () day1_2 :: IO ()
day1_2 = do day1_2 = do
contents <- lines <$> readFile "input/day1.txt" contents <- lines <$> readFile "input/day1.txt"
let [x, y] = transpose $ map read . words <$> contents let [x, y] = transpose $ map read . words <$> contents
putStrLn $ "Day 1, Puzzle 2 solution: " putStrLn $
++ show (similarityScore x y) "Day 1, Puzzle 2 solution: "
++ show (similarityScore x y)

33
src/Day10/Puzzle1.hs
View File

@ -1,34 +1,37 @@
module Day10.Puzzle1 (day10_1) where module Day10.Puzzle1 (day10_1) where
import Data.Char (digitToInt) import Data.Char (digitToInt)
import Data.Graph (graphFromEdges, path, vertices)
import Data.List (uncons) import Data.List (uncons)
import Data.List.Split (chunksOf) import Data.List.Split (chunksOf)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Graph (graphFromEdges, path, vertices)
type Coords = (Int, Int) type Coords = (Int, Int)
type V = (String, Int) type V = (String, Int)
getValue :: [[V]] -> Coords -> V getValue :: [[V]] -> Coords -> V
getValue grid (i, j) = grid !! i !! j getValue grid (i, j) = grid !! i !! j
getEdges :: [[V]] -> Coords -> [Int] getEdges :: [[V]] -> Coords -> [Int]
getEdges grid (i, j) = let value = fst $ grid !! i !! j getEdges grid (i, j) =
adjI = filter (\x -> fst x >= 0 && fst x < length grid && snd x >= 0 && snd x < length (fst . fromJust $ uncons grid)) [ (i, j + 1), (i + 1, j), (i, j - 1), (i - 1, j) ] let value = fst $ grid !! i !! j
in [ snd x | x <- map (getValue grid) adjI, digitToInt (fst . fromJust $ uncons value) == digitToInt (fst . fromJust $ uncons (fst x)) - 1 ] adjI = filter (\x -> fst x >= 0 && fst x < length grid && snd x >= 0 && snd x < length (fst . fromJust $ uncons grid)) [(i, j + 1), (i + 1, j), (i, j - 1), (i - 1, j)]
in [snd x | x <- map (getValue grid) adjI, digitToInt (fst . fromJust $ uncons value) == digitToInt (fst . fromJust $ uncons (fst x)) - 1]
listVertices :: [String] -> [[V]] listVertices :: [String] -> [[V]]
listVertices grid = let l = length $ fst . fromJust $ uncons grid listVertices grid =
in chunksOf l $ zip (map (:[]) (concat grid)) [0..] let l = length $ fst . fromJust $ uncons grid
in chunksOf l $ zip (map (: []) (concat grid)) [0 ..]
day10_1 :: IO () day10_1 :: IO ()
day10_1 = do day10_1 = do
contents <- lines <$> readFile "input/day10.txt" contents <- lines <$> readFile "input/day10.txt"
let grid = listVertices contents let grid = listVertices contents
edgeCoords = [ (x, y) | x <- [0..length grid -1], y <- [0..length (fst . fromJust $ uncons grid) - 1] ] edgeCoords = [(x, y) | x <- [0 .. length grid - 1], y <- [0 .. length (fst . fromJust $ uncons grid) - 1]]
edgeList = [ (x, y, z) | ((x, y), z) <- zip (concat grid) (map (getEdges grid) edgeCoords) ] edgeList = [(x, y, z) | ((x, y), z) <- zip (concat grid) (map (getEdges grid) edgeCoords)]
(graph, nodeFromVertex, _) = graphFromEdges edgeList (graph, nodeFromVertex, _) = graphFromEdges edgeList
startList = [ x | (_, x, _) <- filter (\(x, _, _) -> x == "0") $ map nodeFromVertex $ vertices graph ] startList = [x | (_, x, _) <- filter (\(x, _, _) -> x == "0") $ map nodeFromVertex $ vertices graph]
endList = [ x | (_, x, _) <- filter (\(x, _, _) -> x == "9") $ map nodeFromVertex $ vertices graph ] endList = [x | (_, x, _) <- filter (\(x, _, _) -> x == "9") $ map nodeFromVertex $ vertices graph]
paths = filter id $ [ path graph x y | x <- startList, y <- endList ] paths = filter id $ [path graph x y | x <- startList, y <- endList]
putStrLn $ "Day 10, Puzzle 1 solution: " ++ show (length paths) putStrLn $ "Day 10, Puzzle 1 solution: " ++ show (length paths)

18
src/Day11/Puzzle1.hs
View File

@ -4,11 +4,12 @@ import qualified Data.Map.Strict as M
blinkStone :: (Int, Int) -> [(Int, Int)] blinkStone :: (Int, Int) -> [(Int, Int)]
blinkStone (0, n) = [(1, n)] blinkStone (0, n) = [(1, n)]
blinkStone (s, n) = let ss = show s blinkStone (s, n) =
nDigit = length ss let ss = show s
in if even nDigit nDigit = length ss
then zip (map read [take (nDigit `div` 2) ss, drop (nDigit `div` 2) ss]) [n, n] in if even nDigit
else [(s * 2024, n)] 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 :: Int -> M.Map Int Int -> M.Map Int Int
blink 0 m = m blink 0 m = m
@ -16,6 +17,7 @@ blink n m = blink (n - 1) $ M.fromListWith (+) $ concatMap blinkStone $ M.toList
day11_1 :: IO () day11_1 :: IO ()
day11_1 = do day11_1 = do
contents <- M.fromListWith (+) . flip zip (repeat 1) . map read . words <$> readFile "input/day11.txt" contents <- M.fromListWith (+) . flip zip (repeat 1) . map read . words <$> readFile "input/day11.txt"
putStrLn $ "Day 11, Puzzle 1 solution: " putStrLn $
++ show (M.foldl (+) 0 $ blink 25 contents) "Day 11, Puzzle 1 solution: "
++ show (M.foldl (+) 0 $ blink 25 contents)

18
src/Day11/Puzzle2.hs
View File

@ -4,11 +4,12 @@ import qualified Data.Map.Strict as M
blinkStone :: (Int, Int) -> [(Int, Int)] blinkStone :: (Int, Int) -> [(Int, Int)]
blinkStone (0, n) = [(1, n)] blinkStone (0, n) = [(1, n)]
blinkStone (s, n) = let ss = show s blinkStone (s, n) =
nDigit = length ss let ss = show s
in if even nDigit nDigit = length ss
then zip (map read [take (nDigit `div` 2) ss, drop (nDigit `div` 2) ss]) [n, n] in if even nDigit
else [(s * 2024, n)] 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 :: Int -> M.Map Int Int -> M.Map Int Int
blink 0 m = m blink 0 m = m
@ -16,6 +17,7 @@ blink n m = blink (n - 1) $ M.fromListWith (+) $ concatMap blinkStone $ M.toList
day11_2 :: IO () day11_2 :: IO ()
day11_2 = do day11_2 = do
contents <- M.fromListWith (+) . flip zip (repeat 1) . map read . words <$> readFile "input/day11.txt" contents <- M.fromListWith (+) . flip zip (repeat 1) . map read . words <$> readFile "input/day11.txt"
putStrLn $ "Day 11, Puzzle 2 solution: " putStrLn $
++ show (M.foldl (+) 0 $ blink 75 contents) "Day 11, Puzzle 2 solution: "
++ show (M.foldl (+) 0 $ blink 75 contents)

47
src/Day12/Puzzle1.hs
View File

@ -1,40 +1,45 @@
module Day12.Puzzle1 (day12_1) where module Day12.Puzzle1 (day12_1) where
import Data.Foldable (toList)
import Data.Graph (Tree, Vertex, graphFromEdges, scc)
import Data.List (uncons) import Data.List (uncons)
import Data.List.Split (chunksOf) import Data.List.Split (chunksOf)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Graph (Tree, Vertex, graphFromEdges, scc)
import Data.Foldable (toList)
type Coords = (Int, Int) type Coords = (Int, Int)
type V = (String, Int) type V = (String, Int)
getValue :: [[V]] -> Coords -> V getValue :: [[V]] -> Coords -> V
getValue grid (i, j) = grid !! i !! j getValue grid (i, j) = grid !! i !! j
getEdges :: [[V]] -> Coords -> [Int] getEdges :: [[V]] -> Coords -> [Int]
getEdges grid (i, j) = let value = fst $ grid !! i !! j getEdges grid (i, j) =
adjI = filter (\x -> fst x >= 0 && fst x < length grid && snd x >= 0 && snd x < length (fst . fromJust $ uncons grid)) [ (i, j + 1), (i + 1, j), (i, j - 1), (i - 1, j) ] let value = fst $ grid !! i !! j
in [ snd x | x <- map (getValue grid) adjI, (fst . fromJust $ uncons value) == (fst . fromJust $ uncons (fst x)) ] adjI = filter (\x -> fst x >= 0 && fst x < length grid && snd x >= 0 && snd x < length (fst . fromJust $ uncons grid)) [(i, j + 1), (i + 1, j), (i, j - 1), (i - 1, j)]
in [snd x | x <- map (getValue grid) adjI, (fst . fromJust $ uncons value) == (fst . fromJust $ uncons (fst x))]
listVertices :: [String] -> [[V]] listVertices :: [String] -> [[V]]
listVertices grid = let l = length $ fst . fromJust $ uncons grid listVertices grid =
in chunksOf l $ zip (map (:[]) (concat grid)) [0..] let l = length $ fst . fromJust $ uncons grid
in chunksOf l $ zip (map (: []) (concat grid)) [0 ..]
calculatePerimeter :: (Vertex -> (String, Vertex, [Vertex])) -> Tree Vertex -> Int calculatePerimeter :: (Vertex -> (String, Vertex, [Vertex])) -> Tree Vertex -> Int
calculatePerimeter nodeFromVertex p = let edges = concat [ x | (_, _, x) <- toList $ fmap nodeFromVertex p ] calculatePerimeter nodeFromVertex p =
area = 4 * length p let edges = concat [x | (_, _, x) <- toList $ fmap nodeFromVertex p]
in area - length edges area = 4 * length p
in area - length edges
day12_1 :: IO () day12_1 :: IO ()
day12_1= do day12_1 = do
contents <- lines <$> readFile "input/day12.txt" contents <- lines <$> readFile "input/day12.txt"
let grid = listVertices contents let grid = listVertices contents
edgeCoords = [ (x, y) | x <- [0..length grid -1], y <- [0..length (fst . fromJust $ uncons grid) - 1] ] edgeCoords = [(x, y) | x <- [0 .. length grid - 1], y <- [0 .. length (fst . fromJust $ uncons grid) - 1]]
edgeList = [ (x, y, z) | ((x, y), z) <- zip (concat grid) (map (getEdges grid) edgeCoords) ] edgeList = [(x, y, z) | ((x, y), z) <- zip (concat grid) (map (getEdges grid) edgeCoords)]
(graph, nodeFromVertex, _) = graphFromEdges edgeList (graph, nodeFromVertex, _) = graphFromEdges edgeList
plots = scc graph plots = scc graph
areas = map length plots areas = map length plots
perimeters = map (calculatePerimeter nodeFromVertex) plots perimeters = map (calculatePerimeter nodeFromVertex) plots
putStrLn $ "Day 12, Puzzle 1 solution: " putStrLn $
++ show (sum $ zipWith (*) areas perimeters) "Day 12, Puzzle 1 solution: "
++ show (sum $ zipWith (*) areas perimeters)

46
src/Day13/Puzzle1.hs
View File

@ -1,30 +1,33 @@
{-# OPTIONS_GHC -Wno-type-defaults#-} {-# OPTIONS_GHC -Wno-type-defaults #-}
module Day13.Puzzle1 (day13_1) where module Day13.Puzzle1 (day13_1) where
import Data.Char (isDigit) import Data.Char (isDigit)
import Data.List (uncons)
import Data.List.Split (splitOn, chunksOf)
import Data.Matrix (Matrix, fromLists, toList, rref, zero)
import Data.Either (fromRight) import Data.Either (fromRight)
import Data.Maybe (mapMaybe, fromJust) 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 :: (RealFrac a) => a -> Bool
isAlmostInt x = let diff = x - fromInteger (round x) isAlmostInt x =
in abs diff < 0.001 let diff = x - fromInteger (round x)
in abs diff < 0.001
getMatrix :: (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 getMatrix s =
eq1 = map (fst . fromJust . uncons) nValues let nValues = map (map read . splitOn ",") . splitOn ":" . drop 1 $ filter (\x -> isDigit x || x == ',' || x == ':') s
eq2 = map last nValues eq1 = map (fst . fromJust . uncons) nValues
in fromLists [eq1, eq2] eq2 = map last nValues
in fromLists [eq1, eq2]
solve :: (RealFrac a) => Matrix a -> Maybe [a] solve :: (RealFrac a) => Matrix a -> Maybe [a]
solve eqSystem = let rowEchelonList = toList . fromRight (zero 1 1) $ rref eqSystem solve eqSystem =
solutions = [ rowEchelonList !! 2, rowEchelonList !! 5 ] let rowEchelonList = toList . fromRight (zero 1 1) $ rref eqSystem
in if all isAlmostInt solutions solutions = [rowEchelonList !! 2, rowEchelonList !! 5]
then Just solutions in if all isAlmostInt solutions
else Nothing then Just solutions
else Nothing
cost :: [Int] -> Int cost :: [Int] -> Int
cost [x, y] = 3 * x + y cost [x, y] = 3 * x + y
@ -32,8 +35,9 @@ cost _ = 0
day13_1 :: IO () day13_1 :: IO ()
day13_1 = do day13_1 = do
contents <- map concat . chunksOf 4 . lines <$> readFile "input/day13.txt" contents <- map concat . chunksOf 4 . lines <$> readFile "input/day13.txt"
let eqSystems = map getMatrix contents let eqSystems = map getMatrix contents
solutions = (map . map) round $ mapMaybe solve eqSystems solutions = (map . map) round $ mapMaybe solve eqSystems
putStrLn $ "Day 13, Puzzle 1 solution: " putStrLn $
++ show (sum $ map cost solutions) "Day 13, Puzzle 1 solution: "
++ show (sum $ map cost solutions)

46
src/Day13/Puzzle2.hs
View File

@ -1,34 +1,37 @@
{-# OPTIONS_GHC -Wno-type-defaults#-} {-# OPTIONS_GHC -Wno-type-defaults #-}
module Day13.Puzzle2 (day13_2) where module Day13.Puzzle2 (day13_2) where
import Data.Char (isDigit) import Data.Char (isDigit)
import Data.List (uncons)
import Data.List.Split (splitOn, chunksOf)
import Data.Matrix (Matrix, fromLists, toList, rref, zero)
import Data.Either (fromRight) import Data.Either (fromRight)
import Data.Maybe (mapMaybe, fromJust) 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 :: (RealFrac a) => a -> Bool
isAlmostInt x = let diff = x - fromInteger (round x) isAlmostInt x =
in abs diff < 0.001 let diff = x - fromInteger (round x)
in abs diff < 0.001
multRes :: (Num a) => [a] -> [a] multRes :: (Num a) => [a] -> [a]
multRes [x, y, z] = [x, y, z + 10000000000000] multRes [x, y, z] = [x, y, z + 10000000000000]
multRes xs = xs multRes xs = xs
getMatrix :: (Num a, Read a) => String -> Matrix a 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 getMatrix s =
eq1 = multRes $ map (fst . fromJust . uncons) nValues let nValues = map (map read . splitOn ",") . splitOn ":" . drop 1 $ filter (\x -> isDigit x || x == ',' || x == ':') s
eq2 = multRes $ map last nValues eq1 = multRes $ map (fst . fromJust . uncons) nValues
in fromLists [eq1, eq2] eq2 = multRes $ map last nValues
in fromLists [eq1, eq2]
solve :: (RealFrac a) => Matrix a -> Maybe [a] solve :: (RealFrac a) => Matrix a -> Maybe [a]
solve eqSystem = let rowEchelonList = toList . fromRight (zero 1 1) $ rref eqSystem solve eqSystem =
solutions = [ rowEchelonList !! 2, rowEchelonList !! 5 ] let rowEchelonList = toList . fromRight (zero 1 1) $ rref eqSystem
in if all isAlmostInt solutions solutions = [rowEchelonList !! 2, rowEchelonList !! 5]
then Just solutions in if all isAlmostInt solutions
else Nothing then Just solutions
else Nothing
cost :: [Int] -> Int cost :: [Int] -> Int
cost [x, y] = 3 * x + y cost [x, y] = 3 * x + y
@ -36,8 +39,9 @@ cost _ = 0
day13_2 :: IO () day13_2 :: IO ()
day13_2 = do day13_2 = do
contents <- map concat . chunksOf 4 . lines <$> readFile "input/day13.txt" contents <- map concat . chunksOf 4 . lines <$> readFile "input/day13.txt"
let eqSystems = map getMatrix contents let eqSystems = map getMatrix contents
solutions = (map . map) round $ mapMaybe solve eqSystems solutions = (map . map) round $ mapMaybe solve eqSystems
putStrLn $ "Day 13, Puzzle 2 solution: " putStrLn $
++ show (sum $ map cost solutions) "Day 13, Puzzle 2 solution: "
++ show (sum $ map cost solutions)

64
src/Day14/Puzzle1.hs
View File

@ -6,42 +6,52 @@ import Data.Char (isDigit)
import Data.List.Split (splitOn) import Data.List.Split (splitOn)
type Position = (Int, Int) type Position = (Int, Int)
type Velocity = (Int, Int) type Velocity = (Int, Int)
type Robot = (Position, Velocity) type Robot = (Position, Velocity)
readRobot :: String -> Robot readRobot :: String -> Robot
readRobot s = let [ps, vs] = splitOn " " s readRobot s =
[px, py] = map read . splitOn "," $ filter (\x -> isDigit x || x == ',' || x == '-') ps let [ps, vs] = splitOn " " s
[vx, vy] = map read . splitOn "," $ filter (\x -> isDigit x || x == ',' || x == '-') vs [px, py] = map read . splitOn "," $ filter (\x -> isDigit x || x == ',' || x == '-') ps
in ((px, py), (vx, vy)) [vx, vy] = map read . splitOn "," $ filter (\x -> isDigit x || x == ',' || x == '-') vs
in ((px, py), (vx, vy))
moveRobot :: Int -> Robot -> Robot moveRobot :: Int -> Robot -> Robot
moveRobot 0 r = r moveRobot 0 r = r
moveRobot n r = let (px, py) = fst r moveRobot n r =
(vx, vy) = snd r let (px, py) = fst r
in moveRobot (n - 1) (((px + vx) `mod` 101, (py + vy) `mod` 103), (vx, vy)) (vx, vy) = snd r
in moveRobot (n - 1) (((px + vx) `mod` 101, (py + vy) `mod` 103), (vx, vy))
quadrant :: Robot -> Int quadrant :: Robot -> Int
quadrant r quadrant r
| fst p `elem` [0..49] && | fst p `elem` [0 .. 49]
snd p `elem` [0..50] = 0 && snd p `elem` [0 .. 50] =
| fst p `elem` [51..100] && 0
snd p `elem` [0..50] = 1 | fst p `elem` [51 .. 100]
| fst p `elem` [0..49] && && snd p `elem` [0 .. 50] =
snd p `elem` [52..102] = 2 1
| fst p `elem` [51..100] && | fst p `elem` [0 .. 49]
snd p `elem` [52..102] = 3 && snd p `elem` [52 .. 102] =
| otherwise = -1 2
where p = fst r | fst p `elem` [51 .. 100]
&& snd p `elem` [52 .. 102] =
3
| otherwise = -1
where
p = fst r
day14_1 :: IO () day14_1 :: IO ()
day14_1= do day14_1 = do
contents <- lines <$> readFile "input/day14.txt" contents <- lines <$> readFile "input/day14.txt"
let robots = map readRobot contents let robots = map readRobot contents
robots' = map (moveRobot 100) robots robots' = map (moveRobot 100) robots
firstQ = length $ filter (\r -> quadrant r == 0) robots' firstQ = length $ filter (\r -> quadrant r == 0) robots'
secondQ = length $ filter (\r -> quadrant r == 1) robots' secondQ = length $ filter (\r -> quadrant r == 1) robots'
thirdQ = length $ filter (\r -> quadrant r == 2) robots' thirdQ = length $ filter (\r -> quadrant r == 2) robots'
fourthQ = length $ filter (\r -> quadrant r == 3) robots' fourthQ = length $ filter (\r -> quadrant r == 3) robots'
putStrLn $ "Day 14, Puzzle 1 solution: " putStrLn $
++ show (firstQ * secondQ * thirdQ * fourthQ) "Day 14, Puzzle 1 solution: "
++ show (firstQ * secondQ * thirdQ * fourthQ)

16
src/Day2/Puzzle1.hs
View File

@ -5,13 +5,15 @@ import Data.Ord
isSafe :: [Int] -> Bool isSafe :: [Int] -> Bool
isSafe xs = (isAscending xs || isDescending xs) && maximum distances <= 3 && minimum distances >= 1 isSafe xs = (isAscending xs || isDescending xs) && maximum distances <= 3 && minimum distances >= 1
where isAscending x = x == sort x where
isDescending x = x == sortBy (comparing Down) x isAscending x = x == sort x
distances = map abs $ zipWith (-) xs (drop 1 xs) isDescending x = x == sortBy (comparing Down) x
distances = map abs $ zipWith (-) xs (drop 1 xs)
day2_1 :: IO () day2_1 :: IO ()
day2_1 = do day2_1 = do
contents <- lines <$> readFile "input/day2.txt" contents <- lines <$> readFile "input/day2.txt"
let reports = map read . words <$> contents let reports = map read . words <$> contents
putStrLn $ "Day 2, Puzzle 1 solution: " putStrLn $
++ show (length $ filter isSafe reports) "Day 2, Puzzle 1 solution: "
++ show (length $ filter isSafe reports)

23
src/Day2/Puzzle2.hs
View File

@ -1,22 +1,25 @@
module Day2.Puzzle2 (day2_2) where module Day2.Puzzle2 (day2_2) where
import Data.List (sort, sortBy, inits, tails) import Data.List (inits, sort, sortBy, tails)
import Data.Ord import Data.Ord
isSafe :: [Int] -> Bool isSafe :: [Int] -> Bool
isSafe xs = (isAscending xs || isDescending xs) && maximum distances <= 3 && minimum distances >= 1 isSafe xs = (isAscending xs || isDescending xs) && maximum distances <= 3 && minimum distances >= 1
where isAscending x = x == sort x where
isDescending x = x == sortBy (comparing Down) x isAscending x = x == sort x
distances = map abs $ zipWith (-) xs (drop 1 xs) isDescending x = x == sortBy (comparing Down) x
distances = map abs $ zipWith (-) xs (drop 1 xs)
removeLevel :: [Int] -> [[Int]] removeLevel :: [Int] -> [[Int]]
removeLevel xs = zipWith (++) ys zs removeLevel xs = zipWith (++) ys zs
where ys = map init $ drop 1 (inits xs) where
zs = map (drop 1) $ init (tails xs) ys = map init $ drop 1 (inits xs)
zs = map (drop 1) $ init (tails xs)
day2_2 :: IO () day2_2 :: IO ()
day2_2 = do day2_2 = do
contents <- lines <$> readFile "input/day2.txt" contents <- lines <$> readFile "input/day2.txt"
let reports = map read . words <$> contents let reports = map read . words <$> contents
putStrLn $ "Day 2, Puzzle 2 solution: " putStrLn $
++ show (length . filter (any isSafe) $ map removeLevel reports) "Day 2, Puzzle 2 solution: "
++ show (length . filter (any isSafe) $ map removeLevel reports)

14
src/Day3/Puzzle1.hs
View File

@ -4,12 +4,14 @@ import Data.List.Split (splitOn)
import Text.Regex.TDFA (getAllTextMatches, (=~)) import Text.Regex.TDFA (getAllTextMatches, (=~))
sumMul :: [String] -> Int sumMul :: [String] -> Int
sumMul xs = let vals = map (splitOn "," . filter (`elem` "0123456789,")) xs sumMul xs =
in sum $ map (product . map read) vals let vals = map (splitOn "," . filter (`elem` "0123456789,")) xs
in sum $ map (product . map read) vals
day3_1 :: IO () day3_1 :: IO ()
day3_1 = do day3_1 = do
contents <- readFile "input/day3.txt" contents <- readFile "input/day3.txt"
let mults = getAllTextMatches (contents =~ "mul\\([0-9]+,[0-9]+\\)") :: [String] let mults = getAllTextMatches (contents =~ "mul\\([0-9]+,[0-9]+\\)") :: [String]
putStrLn $ "Day 3, Puzzle 1 solution: " putStrLn $
++ show (sumMul mults) "Day 3, Puzzle 1 solution: "
++ show (sumMul mults)

18
src/Day3/Puzzle2.hs
View File

@ -5,15 +5,17 @@ import Data.List.Split (split, splitOn, startsWith)
import Text.Regex.TDFA (getAllTextMatches, (=~)) import Text.Regex.TDFA (getAllTextMatches, (=~))
sumMul :: [String] -> Int sumMul :: [String] -> Int
sumMul xs = let vals = map (splitOn "," . filter (`elem` "0123456789,")) xs sumMul xs =
in sum $ map (product . map read) vals let vals = map (splitOn "," . filter (`elem` "0123456789,")) xs
in sum $ map (product . map read) vals
filterDonts :: [String] -> String filterDonts :: [String] -> String
filterDonts = concat . filter (not . isPrefixOf "don't()") . concatMap (split (startsWith "do()")) filterDonts = concat . concatMap (filter (not . isPrefixOf "don't()") . split (startsWith "do()"))
day3_2 :: IO() day3_2 :: IO ()
day3_2 = do day3_2 = do
contents <- split (startsWith "don't()") <$> readFile "input/day3.txt" contents <- split (startsWith "don't()") <$> readFile "input/day3.txt"
let mults = getAllTextMatches (filterDonts contents =~ "mul\\([0-9]+,[0-9]+\\)") :: [String] let mults = getAllTextMatches (filterDonts contents =~ "mul\\([0-9]+,[0-9]+\\)") :: [String]
putStrLn $ "Day 3, Puzzle 2 solution: " putStrLn $
++ show (sumMul mults) "Day 3, Puzzle 2 solution: "
++ show (sumMul mults)

39
src/Day4/Puzzle1.hs
View File

@ -1,25 +1,34 @@
module Day4.Puzzle1 (day4_1) where module Day4.Puzzle1 (day4_1) where
import Data.List (transpose, isPrefixOf) import Data.List (isPrefixOf, transpose)
diagonals :: [String] -> [String] diagonals :: [String] -> [String]
diagonals xs = diagonals' xs ++ diagonals' ((transpose . reverse) xs) diagonals xs = diagonals' xs ++ diagonals' ((transpose . reverse) xs)
where diagonals' x = transpose (zipWith drop [0..] x) where
++ transpose (zipWith drop [1..] (transpose x)) diagonals' x =
transpose (zipWith drop [0 ..] x)
++ transpose (zipWith drop [1 ..] (transpose x))
countOccurrences :: String -> [String] -> Int countOccurrences :: String -> [String] -> Int
countOccurrences word text = sum (map (countOccurrences' word) text) + sum (map (countOccurrences' word . reverse) text) countOccurrences word text =
+ sum (map (countOccurrences' word) cols) + sum (map (countOccurrences' word . reverse) cols) sum (map (countOccurrences' word) text)
+ sum (map (countOccurrences' word) diags) + sum (map (countOccurrences' word . reverse) diags) + sum (map (countOccurrences' word . reverse) text)
where cols = transpose text + sum (map (countOccurrences' word) cols)
diags = diagonals text + sum (map (countOccurrences' word . reverse) cols)
countOccurrences' _ [] = 0 + sum (map (countOccurrences' word) diags)
countOccurrences' w txt@(_:rest) = if w `isPrefixOf` txt + sum (map (countOccurrences' word . reverse) diags)
then 1 + countOccurrences' word rest where
else countOccurrences' w rest cols = transpose text
diags = diagonals text
countOccurrences' _ [] = 0
countOccurrences' w txt@(_ : rest) =
if w `isPrefixOf` txt
then 1 + countOccurrences' word rest
else countOccurrences' w rest
day4_1 :: IO () day4_1 :: IO ()
day4_1 = do day4_1 = do
contents <- lines <$> readFile "input/day4.txt" contents <- lines <$> readFile "input/day4.txt"
putStrLn $ "Day 4, Puzzle 1 solution: " putStrLn $
++ show (countOccurrences "XMAS" contents) "Day 4, Puzzle 1 solution: "
++ show (countOccurrences "XMAS" contents)

31
src/Day4/Puzzle2.hs
View File

@ -1,29 +1,34 @@
module Day4.Puzzle2 (day4_2) where module Day4.Puzzle2 (day4_2) where
import Data.List (transpose, isPrefixOf, tails) import Data.List (isPrefixOf, tails, transpose)
diagonals :: [String] -> [String] diagonals :: [String] -> [String]
diagonals xs = diagonals' xs ++ diagonals' ((transpose . reverse) xs) diagonals xs = diagonals' xs ++ diagonals' ((transpose . reverse) xs)
where diagonals' x = transpose (zipWith drop [0..] x) where
++ transpose (zipWith drop [1..] (transpose x)) diagonals' x =
transpose (zipWith drop [0 ..] x)
++ transpose (zipWith drop [1 ..] (transpose x))
countOccurrences :: String -> [String] -> Int countOccurrences :: String -> [String] -> Int
countOccurrences word text = sum (map (countOccurrences' word) diags) + sum (map (countOccurrences' word . reverse) diags) countOccurrences word text = sum (map (countOccurrences' word) diags) + sum (map (countOccurrences' word . reverse) diags)
where diags = diagonals text where
countOccurrences' _ [] = 0 diags = diagonals text
countOccurrences' w txt@(_:rest) = if w `isPrefixOf` txt countOccurrences' _ [] = 0
then 1 + countOccurrences' w rest countOccurrences' w txt@(_ : rest) =
else countOccurrences' w rest if w `isPrefixOf` txt
then 1 + countOccurrences' w rest
else countOccurrences' w rest
submatricesVert :: Int -> [String] -> [[String]] submatricesVert :: Int -> [String] -> [[String]]
submatricesVert _ [] = [] submatricesVert _ [] = []
submatricesVert _ [_] = [] submatricesVert _ [_] = []
submatricesVert _ [_, _] = [] submatricesVert _ [_, _] = []
submatricesVert n matrix@(_:xxs) = submatrix matrix ++ submatricesVert n xxs submatricesVert n matrix@(_ : xxs) = submatrix matrix ++ submatricesVert n xxs
where submatrix m = [take n $ map (take n) m] where
submatrix m = [take n $ map (take n) m]
day4_2 :: IO () day4_2 :: IO ()
day4_2 = do day4_2 = do
contents <- lines <$> readFile "input/day4.txt" contents <- lines <$> readFile "input/day4.txt"
let xmas = length . filter (\x -> countOccurrences "MAS" x == 2) . concatMap (submatricesVert 3) . transpose $ map tails contents let xmas = length . concatMap (filter (\x -> countOccurrences "MAS" x == 2) . submatricesVert 3) . transpose $ map tails contents
putStrLn $ "Day 4, Puzzle 2 solution: " ++ show xmas putStrLn $ "Day 4, Puzzle 2 solution: " ++ show xmas

18
src/Day5/Puzzle1.hs
View File

@ -6,17 +6,19 @@ import Data.List.Split (splitOn)
isSorted :: [(String, String)] -> [String] -> Bool isSorted :: [(String, String)] -> [String] -> Bool
isSorted _ [_] = True isSorted _ [_] = True
isSorted rules (x:xs) = let after = [ p | (p, n) <- rules, n == x ] isSorted rules (x : xs) =
in not (any (`elem` after) xs) && isSorted rules xs let after = [p | (p, n) <- rules, n == x]
in not (any (`elem` after) xs) && isSorted rules xs
getMiddle :: [String] -> String getMiddle :: [String] -> String
getMiddle xs = xs !! (length xs `div` 2) getMiddle xs = xs !! (length xs `div` 2)
day5_1 :: IO () day5_1 :: IO ()
day5_1 = do day5_1 = do
contents <- map (splitOn "|") . lines <$> readFile "input/day5.txt" contents <- map (splitOn "|") . lines <$> readFile "input/day5.txt"
let rules = [ (x, y) | [x, y] <- takeWhile (/= [""]) contents ] let rules = [(x, y) | [x, y] <- takeWhile (/= [""]) contents]
updates = concatMap (map (splitOn ",")) . drop 1 $ dropWhile (/= [""]) contents updates = concatMap (map (splitOn ",")) . drop 1 $ dropWhile (/= [""]) contents
sorted = filter (isSorted rules) updates sorted = filter (isSorted rules) updates
putStrLn $ "Day 5, Puzzle 1 solution: " putStrLn $
++ (show :: Int -> String) (sum $ map (read . getMiddle) sorted) "Day 5, Puzzle 1 solution: "
++ (show :: Int -> String) (sum $ map (read . getMiddle) sorted)

29
src/Day5/Puzzle2.hs
View File

@ -7,24 +7,27 @@ import Data.List.Split (splitOn)
isSorted :: [(Int, Int)] -> [Int] -> Bool isSorted :: [(Int, Int)] -> [Int] -> Bool
isSorted _ [_] = True isSorted _ [_] = True
isSorted rules (x:xs) = let after = [ p | (p, n) <- rules, n == x ] isSorted rules (x : xs) =
in not (any (`elem` after) xs) && isSorted rules xs let after = [p | (p, n) <- rules, n == x]
in not (any (`elem` after) xs) && isSorted rules xs
getMiddle :: [Int] -> Int getMiddle :: [Int] -> Int
getMiddle xs = xs !! (length xs `div` 2) getMiddle xs = xs !! (length xs `div` 2)
sortOnRules :: [(Int, Int)] -> [Int] -> [Int] sortOnRules :: [(Int, Int)] -> [Int] -> [Int]
sortOnRules _ [] = [] sortOnRules _ [] = []
sortOnRules rules (x:xs) = sortOnRules rules beforeArray ++ [x] ++ sortOnRules rules afterArray sortOnRules rules (x : xs) = sortOnRules rules beforeArray ++ [x] ++ sortOnRules rules afterArray
where afterArray = xs \\ before where
beforeArray = xs \\ afterArray afterArray = xs \\ before
before = [ p | (p, n) <- rules, n == x ] beforeArray = xs \\ afterArray
before = [p | (p, n) <- rules, n == x]
day5_2 :: IO () day5_2 :: IO ()
day5_2 = do day5_2 = do
contents <- map (splitOn "|") . lines <$> readFile "input/day5.txt" contents <- map (splitOn "|") . lines <$> readFile "input/day5.txt"
let rules = [ (read x, read y) | [x, y] <- takeWhile (/= [""]) contents ] 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 unsorted = filter (not . isSorted rules) . map (map read) $ concatMap (map (splitOn ",")) . drop 1 $ dropWhile (/= [""]) contents
fixUnsorted = map (sortOnRules rules) unsorted fixUnsorted = map (sortOnRules rules) unsorted
putStrLn $ "Day 5, Puzzle 2 solution: " putStrLn $
++ show (sum $ map getMiddle fixUnsorted) "Day 5, Puzzle 2 solution: "
++ show (sum $ map getMiddle fixUnsorted)

93
src/Day6/Puzzle1.hs
View File

@ -1,11 +1,13 @@
module Day6.Puzzle1 (day6_1) where module Day6.Puzzle1 (day6_1) where
import Data.List (elemIndex, uncons) import Data.List (elemIndex, uncons)
import Data.Maybe (isJust, fromMaybe, fromJust) import Data.Maybe (fromJust, fromMaybe, isJust)
type Grid = [String] type Grid = [String]
type Position = (Int, Int) type Position = (Int, Int)
data Direction = U | R | D | L deriving Eq
data Direction = U | R | D | L deriving (Eq)
getDirection :: Char -> Maybe Direction getDirection :: Char -> Maybe Direction
getDirection '^' = Just U getDirection '^' = Just U
@ -14,10 +16,11 @@ getDirection 'v' = Just D
getDirection '<' = Just L getDirection '<' = Just L
getDirection _ = Nothing getDirection _ = Nothing
getStartPosition:: Char -> Grid -> Position getStartPosition :: Char -> Grid -> Position
getStartPosition c grid = (x, y) getStartPosition c grid = (x, y)
where x = fromMaybe (-1) . elemIndex True . map (isJust . elemIndex c) $ grid where
y = if x == -1 then -1 else fromMaybe (-1) . elemIndex c $ grid !! x 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 :: Position -> Grid -> Char
getGridVal (x, y) grid = (grid !! x) !! y getGridVal (x, y) grid = (grid !! x) !! y
@ -26,44 +29,56 @@ isInside :: Position -> Grid -> Bool
isInside (x, y) grid = x >= 0 && y >= 0 && x < length grid && y < length (fst . fromJust $ uncons grid) isInside (x, y) grid = x >= 0 && y >= 0 && x < length grid && y < length (fst . fromJust $ uncons grid)
getNextPosition :: Position -> Direction -> Grid -> (Position, Direction) getNextPosition :: Position -> Direction -> Grid -> (Position, Direction)
getNextPosition (x, y) U grid = let newPos = (x - 1, y) getNextPosition (x, y) U grid =
gridVal = getGridVal newPos grid let newPos = (x - 1, y)
in if newPos `isInside` grid && gridVal == '#' gridVal = getGridVal newPos grid
then getNextPosition (x, y) R grid in if newPos `isInside` grid && gridVal == '#'
else (newPos, U) then getNextPosition (x, y) R grid
getNextPosition (x, y) R grid = let newPos = (x, y + 1) else (newPos, U)
gridVal = getGridVal newPos grid getNextPosition (x, y) R grid =
in if newPos `isInside` grid && gridVal == '#' let newPos = (x, y + 1)
then getNextPosition (x, y) D grid gridVal = getGridVal newPos grid
else (newPos, R) in if newPos `isInside` grid && gridVal == '#'
getNextPosition (x, y) D grid = let newPos = (x + 1, y) then getNextPosition (x, y) D grid
gridVal = getGridVal newPos grid else (newPos, R)
in if newPos `isInside` grid && gridVal == '#' getNextPosition (x, y) D grid =
then getNextPosition (x, y) L grid let newPos = (x + 1, y)
else (newPos, D) gridVal = getGridVal newPos grid
getNextPosition (x, y) L grid = let newPos = (x, y - 1) in if newPos `isInside` grid && gridVal == '#'
gridVal = getGridVal newPos grid then getNextPosition (x, y) L grid
in if newPos `isInside` grid && gridVal == '#' else (newPos, D)
then getNextPosition (x, y) U grid getNextPosition (x, y) L grid =
else (newPos, L) 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 :: Position -> Char -> Grid -> Grid
markVisited (x, y) c grid = let row = grid !! x markVisited (x, y) c grid =
newRow = take y row ++ [c] ++ drop (y + 1) row let row = grid !! x
in take x grid ++ [newRow] ++ drop (x + 1) grid newRow = take y row ++ [c] ++ drop (y + 1) row
in take x grid ++ [newRow] ++ drop (x + 1) grid
visitGrid :: Position -> Direction -> Grid -> Grid visitGrid :: Position -> Direction -> Grid -> Grid
visitGrid (x, y) direction grid = let newGrid = markVisited (x, y) 'X' grid visitGrid (x, y) direction grid =
(nextPosition, newDirection) = getNextPosition (x, y) direction grid let newGrid = markVisited (x, y) 'X' grid
in if nextPosition `isInside` newGrid (nextPosition, newDirection) = getNextPosition (x, y) direction grid
then visitGrid nextPosition newDirection newGrid in if nextPosition `isInside` newGrid
else newGrid then visitGrid nextPosition newDirection newGrid
else newGrid
day6_1 :: IO () day6_1 :: IO ()
day6_1 = do day6_1 = do
contents <- lines <$> readFile "input/day6.txt" 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 '^' let (x, y) =
<*> getStartPosition '<' <*> getStartPosition '>' $ contents (\a b c d -> fst . fromJust $ uncons $ filter ((>= 0) . fst) [a, b, c, d])
direction = fromJust . getDirection $ (contents !! x) !! y <$> getStartPosition 'v'
putStrLn $ "Day 6, Puzzle 1 solution: " <*> getStartPosition '^'
++ show (length . filter (== 'X') . concat $ visitGrid (x, y) direction contents) <*> 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)

122
src/Day6/Puzzle2.hs
View File

@ -1,11 +1,13 @@
module Day6.Puzzle2 (day6_2) where module Day6.Puzzle2 (day6_2) where
import Data.List (elemIndex, uncons) import Data.List (elemIndex, uncons)
import Data.Maybe (isJust, fromMaybe, fromJust) import Data.Maybe (fromJust, fromMaybe, isJust)
type Grid = [String] type Grid = [String]
type Position = (Int, Int) type Position = (Int, Int)
data Direction = U | R | D | L deriving Eq
data Direction = U | R | D | L deriving (Eq)
getDirection :: Char -> Maybe Direction getDirection :: Char -> Maybe Direction
getDirection '^' = Just U getDirection '^' = Just U
@ -22,8 +24,9 @@ printDirection L = '<'
getStartPosition :: Char -> Grid -> Position getStartPosition :: Char -> Grid -> Position
getStartPosition c grid = (x, y) getStartPosition c grid = (x, y)
where x = fromMaybe (-1) . elemIndex True . map (isJust . elemIndex c) $ grid where
y = if x == -1 then -1 else fromMaybe (-1) . elemIndex c $ grid !! x 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 :: Position -> Grid -> Char
getGridVal (x, y) grid = (grid !! x) !! y getGridVal (x, y) grid = (grid !! x) !! y
@ -32,61 +35,76 @@ isInside :: Position -> Grid -> Bool
isInside (x, y) grid = x >= 0 && y >= 0 && x < length grid && y < length (fst . fromJust $ uncons grid) isInside (x, y) grid = x >= 0 && y >= 0 && x < length grid && y < length (fst . fromJust $ uncons grid)
getNextPosition :: Position -> Direction -> Grid -> (Position, Direction) getNextPosition :: Position -> Direction -> Grid -> (Position, Direction)
getNextPosition (x, y) U grid = let newPos = (x - 1, y) getNextPosition (x, y) U grid =
gridVal = getGridVal newPos grid let newPos = (x - 1, y)
in if newPos `isInside` grid && gridVal == '#' gridVal = getGridVal newPos grid
then getNextPosition (x, y) R grid in if newPos `isInside` grid && gridVal == '#'
else (newPos, U) then getNextPosition (x, y) R grid
getNextPosition (x, y) R grid = let newPos = (x, y + 1) else (newPos, U)
gridVal = getGridVal newPos grid getNextPosition (x, y) R grid =
in if newPos `isInside` grid && gridVal == '#' let newPos = (x, y + 1)
then getNextPosition (x, y) D grid gridVal = getGridVal newPos grid
else (newPos, R) in if newPos `isInside` grid && gridVal == '#'
getNextPosition (x, y) D grid = let newPos = (x + 1, y) then getNextPosition (x, y) D grid
gridVal = getGridVal newPos grid else (newPos, R)
in if newPos `isInside` grid && gridVal == '#' getNextPosition (x, y) D grid =
then getNextPosition (x, y) L grid let newPos = (x + 1, y)
else (newPos, D) gridVal = getGridVal newPos grid
getNextPosition (x, y) L grid = let newPos = (x, y - 1) in if newPos `isInside` grid && gridVal == '#'
gridVal = getGridVal newPos grid then getNextPosition (x, y) L grid
in if newPos `isInside` grid && gridVal == '#' else (newPos, D)
then getNextPosition (x, y) U grid getNextPosition (x, y) L grid =
else (newPos, L) 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 :: Position -> Char -> Grid -> Grid
markVisited (x, y) c grid = let gridVal = getGridVal (x, y) grid markVisited (x, y) c grid =
in if gridVal == '#' || gridVal == '^' || gridVal == '>' || gridVal == 'v' || gridVal == '<' let gridVal = getGridVal (x, y) grid
then grid in if gridVal == '#' || gridVal == '^' || gridVal == '>' || gridVal == 'v' || gridVal == '<'
else let row = grid !! x then grid
newRow = take y row ++ [c] ++ drop (y + 1) row else
in take x grid ++ [newRow] ++ drop (x + 1) 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 :: Position -> Direction -> Grid -> Grid
visitGrid (x, y) direction grid = let newGrid = markVisited (x, y) 'X' grid visitGrid (x, y) direction grid =
(nextPosition, newDirection) = getNextPosition (x, y) direction grid let newGrid = markVisited (x, y) 'X' grid
in if nextPosition `isInside` newGrid (nextPosition, newDirection) = getNextPosition (x, y) direction grid
then visitGrid nextPosition newDirection newGrid in if nextPosition `isInside` newGrid
else newGrid then visitGrid nextPosition newDirection newGrid
else newGrid
checkGridLoop :: Position -> Direction -> Grid -> Bool checkGridLoop :: Position -> Direction -> Grid -> Bool
checkGridLoop startPosition direction grid = let (nextPosition, newDirection) = getNextPosition startPosition direction grid checkGridLoop startPosition direction grid =
newDirectionChar = printDirection newDirection let (nextPosition, newDirection) = getNextPosition startPosition direction grid
newGrid = markVisited nextPosition newDirectionChar grid newDirectionChar = printDirection newDirection
in (nextPosition `isInside` grid) newGrid = markVisited nextPosition newDirectionChar grid
&& ((getGridVal nextPosition grid == newDirectionChar) in (nextPosition `isInside` grid)
|| checkGridLoop nextPosition newDirection newGrid) && ( (getGridVal nextPosition grid == newDirectionChar)
|| checkGridLoop nextPosition newDirection newGrid
)
setGridObstacles :: Position -> Grid -> [Grid] setGridObstacles :: Position -> Grid -> [Grid]
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' ] setGridObstacles startPosition grid =
in zipWith (`markVisited` '#') positions (replicate (length positions) 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)
day6_2 :: IO () day6_2 :: IO ()
day6_2 = do day6_2 = do
contents <- lines <$> readFile "input/day6.txt" 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 '^' let (x, y) =
<*> getStartPosition '<' <*> getStartPosition '>' $ contents (\a b c d -> fst . fromJust $ uncons $ filter ((>= 0) . fst) [a, b, c, d])
direction = fromJust . getDirection $ (contents !! x) !! y <$> getStartPosition 'v'
grid = visitGrid (x, y) direction contents <*> getStartPosition '^'
gridObstacles = setGridObstacles (x, y) grid <*> getStartPosition '<'
loops = filter (checkGridLoop (x, y) direction) gridObstacles <*> getStartPosition '>'
putStrLn $ "Day 6, Puzzle 2 solution: " ++ show (length loops) $ contents
direction = fromJust . getDirection $ (contents !! x) !! y
grid = visitGrid (x, y) direction contents
gridObstacles = setGridObstacles (x, y) grid
loops = filter (checkGridLoop (x, y) direction) gridObstacles
putStrLn $ "Day 6, Puzzle 2 solution: " ++ show (length loops)

22
src/Day7/Puzzle1.hs
View File

@ -8,16 +8,18 @@ type Equation = (Int, [Int])
isSolvable :: Int -> Equation -> Bool isSolvable :: Int -> Equation -> Bool
isSolvable cur (result, []) = cur == result isSolvable cur (result, []) = cur == result
isSolvable cur (result, [x]) = cur + x == result || cur * x == 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 (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 (cur * x * y) (result, ys) || isSolvable (cur * x + y) (result, ys)
|| isSolvable (cur * x * y) (result, ys)
day7_1 :: IO () day7_1 :: IO ()
day7_1 = do day7_1 = do
[x, y] <- transpose . map (splitOn ":") . lines <$> readFile "input/day7.txt" [x, y] <- transpose . map (splitOn ":") . lines <$> readFile "input/day7.txt"
let results = map read x let results = map read x
values = map read <$> map words y values = map read <$> map words y
equations = zip results values equations = zip results values
putStrLn $ "Day 7, Puzzle 1 solution: " putStrLn $
++ show (sum . map fst $ filter (isSolvable 0) equations) "Day 7, Puzzle 1 solution: "
++ show (sum . map fst $ filter (isSolvable 0) equations)

32
src/Day7/Puzzle2.hs
View File

@ -11,21 +11,23 @@ concatInt x y = read $ show x ++ show y
isSolvable :: Int -> Equation -> Bool isSolvable :: Int -> Equation -> Bool
isSolvable cur (result, []) = cur == result isSolvable cur (result, []) = cur == result
isSolvable cur (result, [x]) = cur + x == result || cur * x == result || cur `concatInt` x == 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 (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 * 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 `concatInt` 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) || isSolvable ((cur `concatInt` x) * y) (result, ys)
|| isSolvable ((cur `concatInt` x) `concatInt` y) (result, ys)
day7_2 :: IO () day7_2 :: IO ()
day7_2 = do day7_2 = do
[x, y] <- transpose . map (splitOn ":") . lines <$> readFile "input/day7.txt" [x, y] <- transpose . map (splitOn ":") . lines <$> readFile "input/day7.txt"
let results = map read x let results = map read x
values = map read <$> map words y values = map read <$> map words y
equations = zip results values equations = zip results values
putStrLn $ "Day 7, Puzzle 2 solution: " putStrLn $
++ show (sum . map fst $ filter (isSolvable 0) equations) "Day 7, Puzzle 2 solution: "
++ show (sum . map fst $ filter (isSolvable 0) equations)

46
src/Day8/Puzzle1.hs
View File

@ -1,40 +1,46 @@
module Day8.Puzzle1 (day8_1) where module Day8.Puzzle1 (day8_1) where
import Control.Applicative
import Data.List (uncons) import Data.List (uncons)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Control.Applicative
import qualified Data.Set as Set import qualified Data.Set as Set
type Freq = Char type Freq = Char
type Coords = (Int, Int) type Coords = (Int, Int)
data Antenna = Antenna { frequency :: Freq
, coordinates :: Coords data Antenna = Antenna
} deriving (Show, Eq) { frequency :: Freq,
coordinates :: Coords
}
deriving (Show, Eq)
readAntenna :: Freq -> Coords -> Antenna readAntenna :: Freq -> Coords -> Antenna
readAntenna freq coords = Antenna {frequency=freq, coordinates=coords} readAntenna freq coords = Antenna {frequency = freq, coordinates = coords}
getAntennas :: [String] -> [Antenna] getAntennas :: [String] -> [Antenna]
getAntennas grid = concat . getZipList $ getAntennasRow <$> ZipList [0..] <*> ZipList grid getAntennas grid = concat . getZipList $ getAntennasRow <$> ZipList [0 ..] <*> ZipList grid
where getAntennasRow n row = [ readAntenna x (n, y) | (x, y) <- zip row [0..], x /= '.' ] where
getAntennasRow n row = [readAntenna x (n, y) | (x, y) <- zip row [0 ..], x /= '.']
isInside :: Coords -> Int -> Int -> Bool isInside :: Coords -> Int -> Int -> Bool
isInside c x y = fst c >= 0 && fst c < x && snd c >= 0 && snd c < y isInside c x y = fst c >= 0 && fst c < x && snd c >= 0 && snd c < y
getAntinodes :: Antenna -> Antenna -> Int -> Int -> [Coords] getAntinodes :: Antenna -> Antenna -> Int -> Int -> [Coords]
getAntinodes a b maxX maxY = let xa = fst $ coordinates a getAntinodes a b maxX maxY =
ya = snd $ coordinates a let xa = fst $ coordinates a
xb = fst $ coordinates b ya = snd $ coordinates a
yb = snd $ coordinates b xb = fst $ coordinates b
in if frequency a /= frequency b || coordinates a == coordinates b yb = snd $ coordinates b
then [] in if frequency a /= frequency b || coordinates a == coordinates b
else filter (\c -> isInside c maxX maxY) [(2 * xa - xb, 2 * ya - yb), (2 * xb - xa, 2 * yb - ya)] then []
else filter (\c -> isInside c maxX maxY) [(2 * xa - xb, 2 * ya - yb), (2 * xb - xa, 2 * yb - ya)]
day8_1 :: IO () day8_1 :: IO ()
day8_1 = do day8_1 = do
contents <- lines <$> readFile "input/day8.txt" contents <- lines <$> readFile "input/day8.txt"
let antennas = getAntennas contents let antennas = getAntennas contents
x = length contents x = length contents
y = length $ fst . fromJust $ uncons 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 ] 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) putStrLn $ "Day 8, Puzzle 1 solution: " ++ show (length antinodes)

60
src/Day8/Puzzle2.hs
View File

@ -1,49 +1,57 @@
module Day8.Puzzle2 (day8_2) where module Day8.Puzzle2 (day8_2) where
import Control.Applicative
import Data.Bifunctor (bimap)
import Data.List (uncons) import Data.List (uncons)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Control.Applicative
import Data.Set (fromList) import Data.Set (fromList)
import Data.Bifunctor (bimap)
type Freq = Char type Freq = Char
type Coords = (Int, Int) type Coords = (Int, Int)
data Antenna = Antenna { frequency :: Freq
, coordinates :: Coords data Antenna = Antenna
} deriving (Show, Eq) { frequency :: Freq,
coordinates :: Coords
}
deriving (Show, Eq)
readAntenna :: Freq -> Coords -> Antenna readAntenna :: Freq -> Coords -> Antenna
readAntenna freq coords = Antenna {frequency=freq, coordinates=coords} readAntenna freq coords = Antenna {frequency = freq, coordinates = coords}
getAntennas :: [String] -> [Antenna] getAntennas :: [String] -> [Antenna]
getAntennas grid = concat . getZipList $ getAntennasRow <$> ZipList [0..] <*> ZipList grid getAntennas grid = concat . getZipList $ getAntennasRow <$> ZipList [0 ..] <*> ZipList grid
where getAntennasRow n row = [ readAntenna x (n, y) | (x, y) <- zip row [0..], x /= '.' ] where
getAntennasRow n row = [readAntenna x (n, y) | (x, y) <- zip row [0 ..], x /= '.']
isInside :: Coords -> Int -> Int -> Bool isInside :: Coords -> Int -> Int -> Bool
isInside c x y = fst c >= 0 && fst c < x && snd c >= 0 && snd c < y isInside c x y = fst c >= 0 && fst c < x && snd c >= 0 && snd c < y
generateCoords :: Coords -> Coords -> [Coords] generateCoords :: Coords -> Coords -> [Coords]
generateCoords c offset = scanl shiftCoords c (repeat offset) generateCoords c offset = scanl shiftCoords c (repeat offset)
where shiftCoords x = bimap (fst x +) (snd x +) where
shiftCoords x = bimap (fst x +) (snd x +)
getAntinodes :: Antenna -> Antenna -> Int -> Int -> [Coords] getAntinodes :: Antenna -> Antenna -> Int -> Int -> [Coords]
getAntinodes a b maxX maxY = let xa = fst $ coordinates a getAntinodes a b maxX maxY =
ya = snd $ coordinates a let xa = fst $ coordinates a
xb = fst $ coordinates b ya = snd $ coordinates a
yb = snd $ coordinates b xb = fst $ coordinates b
distX = xa - xb yb = snd $ coordinates b
distY = ya - yb distX = xa - xb
in if frequency a /= frequency b || coordinates a == coordinates b distY = ya - yb
then [] in if frequency a /= frequency b || coordinates a == coordinates b
else filter (\c -> isInside c maxX maxY) [(2 * xa - xb, 2 * ya - yb), (2 * xb - xa, 2 * yb - ya)] then []
++ takeWhile (\c -> isInside c maxX maxY) (generateCoords (coordinates a) (distX, distY)) else
++ takeWhile (\c -> isInside c maxX maxY) (generateCoords (coordinates b) (-distX, -distY)) filter (\c -> isInside c maxX maxY) [(2 * xa - xb, 2 * ya - yb), (2 * xb - xa, 2 * yb - ya)]
++ takeWhile (\c -> isInside c maxX maxY) (generateCoords (coordinates a) (distX, distY))
++ takeWhile (\c -> isInside c maxX maxY) (generateCoords (coordinates b) (-distX, -distY))
day8_2 :: IO () day8_2 :: IO ()
day8_2 = do day8_2 = do
contents <- lines <$> readFile "input/day8.txt" contents <- lines <$> readFile "input/day8.txt"
let antennas = getAntennas contents let antennas = getAntennas contents
x = length contents x = length contents
y = length $ fst . fromJust $ uncons 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) putStrLn $ "Day 8, Puzzle 2 solution: " ++ show (length antinodes)

35
src/Day9/Puzzle1.hs
View File

@ -1,31 +1,34 @@
module Day9.Puzzle1 (day9_1) where module Day9.Puzzle1 (day9_1) where
import Data.List (intersperse) import Control.Applicative
import Data.Char (digitToInt) import Data.Char (digitToInt)
import qualified Data.Foldable as F
import Data.List (intersperse)
import Data.Maybe (fromJust, fromMaybe) import Data.Maybe (fromJust, fromMaybe)
import qualified Data.Sequence as S import qualified Data.Sequence as S
import qualified Data.Foldable as F
import Control.Applicative
parseDiskMap :: [Int] -> S.Seq Int parseDiskMap :: [Int] -> S.Seq Int
parseDiskMap xs = let values = intersperse (-1) [0..] parseDiskMap xs =
in S.fromList . concat . getZipList $ replicate <$> ZipList xs <*> ZipList values let values = intersperse (-1) [0 ..]
in S.fromList . concat . getZipList $ replicate <$> ZipList xs <*> ZipList values
compact :: S.Seq Int -> S.Seq Int compact :: S.Seq Int -> S.Seq Int
compact xs compact xs
| fileIndex == -1 = xs | fileIndex == -1 = xs
| otherwise = S.filter (/= -1) $ startDisk S.>< (compact . S.insertAt 0 fileVal . S.deleteAt 0 $ S.deleteAt fileIndex endDisk) | 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 where
(startDisk, endDisk) = S.splitAt spaceIndex xs spaceIndex = fromJust $ S.elemIndexL (-1) xs
fileIndex = fromMaybe (-1) (S.findIndexR (/= -1) endDisk) (startDisk, endDisk) = S.splitAt spaceIndex xs
fileVal = S.index endDisk fileIndex fileIndex = fromMaybe (-1) (S.findIndexR (/= -1) endDisk)
fileVal = S.index endDisk fileIndex
checksum :: [Int] -> Int checksum :: [Int] -> Int
checksum xs = sum $ zipWith (*) xs [0..] checksum xs = sum $ zipWith (*) xs [0 ..]
day9_1 :: IO () day9_1 :: IO ()
day9_1 = do day9_1 = do
contents <- init <$> readFile "input/day9.txt" contents <- init <$> readFile "input/day9.txt"
let diskMap = map digitToInt contents let diskMap = map digitToInt contents
putStrLn $ "Day 9, Puzzle 1 solution: " putStrLn $
++ show (checksum . F.toList . compact $ parseDiskMap diskMap) "Day 9, Puzzle 1 solution: "
++ show (checksum . F.toList . compact $ parseDiskMap diskMap)

59
src/Day9/Puzzle2.hs
View File

@ -2,18 +2,19 @@
module Day9.Puzzle2 (day9_2) where module Day9.Puzzle2 (day9_2) where
import Data.List (intersperse, groupBy)
import Data.Char (digitToInt) import Data.Char (digitToInt)
import Data.Maybe (fromMaybe)
import Data.Function (on)
import qualified Data.Sequence as S
import qualified Data.Foldable as F import qualified Data.Foldable as F
import Data.Function (on)
import Data.List (groupBy, intersperse)
import Data.Maybe (fromMaybe)
import qualified Data.Sequence as S
type DiskElem = (Int, Int) type DiskElem = (Int, Int)
parseDiskMap :: [Int] -> S.Seq DiskElem parseDiskMap :: [Int] -> S.Seq DiskElem
parseDiskMap xs = let values = intersperse (-1) [0..] parseDiskMap xs =
in S.fromList $ zip values xs let values = intersperse (-1) [0 ..]
in S.fromList $ zip values xs
isSpaceEnough :: Int -> DiskElem -> Bool isSpaceEnough :: Int -> DiskElem -> Bool
isSpaceEnough n (-1, l) = l >= n isSpaceEnough n (-1, l) = l >= n
@ -29,38 +30,42 @@ compareFileValue :: Int -> DiskElem -> Bool
compareFileValue x (v, _) = x == v compareFileValue x (v, _) = x == v
moveFile :: Int -> Int -> DiskElem -> DiskElem -> S.Seq DiskElem -> S.Seq DiskElem moveFile :: Int -> Int -> DiskElem -> DiskElem -> S.Seq DiskElem -> S.Seq DiskElem
moveFile i sIndex sVal fVal xs = let xs' = F.toList . S.insertAt sIndex fVal . S.insertAt sIndex sVal . S.deleteAt sIndex . S.insertAt i (-1, snd fVal) $ S.deleteAt i xs moveFile i sIndex sVal fVal xs =
in S.fromList $ map (foldl1 combineSpace) $ groupBy ((==) `on` fst) xs' let xs' = F.toList . S.insertAt sIndex fVal . S.insertAt sIndex sVal . S.deleteAt sIndex . S.insertAt i (-1, snd fVal) $ S.deleteAt i xs
in S.fromList $ map (foldl1 combineSpace) $ groupBy ((==) `on` fst) xs'
compactFiles :: Int -> S.Seq DiskElem -> S.Seq DiskElem compactFiles :: Int -> S.Seq DiskElem -> S.Seq DiskElem
compactFiles (-1) xs = xs compactFiles (-1) xs = xs
compactFiles 0 xs = xs compactFiles 0 xs = xs
compactFiles n xs = if fst fVal == -1 || sIndex == -1 || sIndex >= n compactFiles n xs =
then compactFiles (n - 1) xs if fst fVal == -1 || sIndex == -1 || sIndex >= n
else compactFiles fIndex xs' then compactFiles (n - 1) xs
where fVal = S.index xs n else compactFiles fIndex xs'
sIndex = fromMaybe (-1) $ S.findIndexL (isSpaceEnough (snd fVal)) xs where
sVal = updateSpace (snd fVal) (fromMaybe (-1, 0) $ S.lookup sIndex xs) fVal = S.index xs n
xs' = moveFile n sIndex sVal fVal xs sIndex = fromMaybe (-1) $ S.findIndexL (isSpaceEnough (snd fVal)) xs
fIndex = fromMaybe (-1) $ S.findIndexR (compareFileValue (fst fVal - 1)) xs' sVal = updateSpace (snd fVal) (fromMaybe (-1, 0) $ S.lookup sIndex xs)
xs' = moveFile n sIndex sVal fVal xs
fIndex = fromMaybe (-1) $ S.findIndexR (compareFileValue (fst fVal - 1)) xs'
maskMinus1 :: [Int] -> [Int] maskMinus1 :: [Int] -> [Int]
maskMinus1 [] = [] maskMinus1 [] = []
maskMinus1 (l:ls) maskMinus1 (l : ls)
| l == -1 = 0:maskMinus1 ls | l == -1 = 0 : maskMinus1 ls
| otherwise = l:maskMinus1 ls | otherwise = l : maskMinus1 ls
tuplesToIntList :: S.Seq DiskElem -> [Int] tuplesToIntList :: S.Seq DiskElem -> [Int]
tuplesToIntList disk = let listDisk = F.toList disk tuplesToIntList disk =
in concatMap (\x -> replicate (snd x) (fst x)) listDisk let listDisk = F.toList disk
in concatMap (\x -> replicate (snd x) (fst x)) listDisk
checksum :: [Int] -> Int checksum :: [Int] -> Int
checksum xs = sum $ zipWith (*) (maskMinus1 xs) [0..] checksum xs = sum $ zipWith (*) (maskMinus1 xs) [0 ..]
day9_2 :: IO () day9_2 :: IO ()
day9_2 = do day9_2 = do
contents <- init <$> readFile "input/day9.txt" 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 i = fromMaybe (-1) $ S.findIndexR (\x -> fst x /= -1) disk
compactedDisk = tuplesToIntList $ S.filter (\x -> snd x > 0) $ compactFiles i 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)