From ba73f8c6388a83301bfb76247851fae39ab93020 Mon Sep 17 00:00:00 2001 From: Daniele Fucini Date: Sun, 15 Dec 2024 10:31:53 +0100 Subject: [PATCH] Fix code style with ormolu --- src/Day1/Puzzle1.hs | 11 ++-- src/Day1/Puzzle2.hs | 16 +++--- src/Day10/Puzzle1.hs | 33 ++++++------ src/Day11/Puzzle1.hs | 18 ++++--- src/Day11/Puzzle2.hs | 18 ++++--- src/Day12/Puzzle1.hs | 47 +++++++++-------- src/Day13/Puzzle1.hs | 46 ++++++++-------- src/Day13/Puzzle2.hs | 46 ++++++++-------- src/Day14/Puzzle1.hs | 64 +++++++++++++---------- src/Day2/Puzzle1.hs | 16 +++--- src/Day2/Puzzle2.hs | 23 ++++---- src/Day3/Puzzle1.hs | 14 ++--- src/Day3/Puzzle2.hs | 18 ++++--- src/Day4/Puzzle1.hs | 39 ++++++++------ src/Day4/Puzzle2.hs | 31 ++++++----- src/Day5/Puzzle1.hs | 18 ++++--- src/Day5/Puzzle2.hs | 29 +++++----- src/Day6/Puzzle1.hs | 93 +++++++++++++++++++-------------- src/Day6/Puzzle2.hs | 122 +++++++++++++++++++++++++------------------ src/Day7/Puzzle1.hs | 22 ++++---- src/Day7/Puzzle2.hs | 32 ++++++------ src/Day8/Puzzle1.hs | 46 +++++++++------- src/Day8/Puzzle2.hs | 60 ++++++++++++--------- src/Day9/Puzzle1.hs | 35 +++++++------ src/Day9/Puzzle2.hs | 59 +++++++++++---------- 25 files changed, 538 insertions(+), 418 deletions(-) diff --git a/src/Day1/Puzzle1.hs b/src/Day1/Puzzle1.hs index 52061ab..e229270 100644 --- a/src/Day1/Puzzle1.hs +++ b/src/Day1/Puzzle1.hs @@ -2,14 +2,15 @@ module Day1.Puzzle1 (day1_1) where -import Data.List (transpose, sort) +import Data.List (sort, transpose) listDistance :: [Int] -> [Int] -> Int listDistance xs ys = sum $ map abs $ zipWith (-) (sort xs) (sort ys) day1_1 :: IO () day1_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) + contents <- lines <$> readFile "input/day1.txt" + let [x, y] = transpose $ map read . words <$> contents + putStrLn $ + "Day 1, Puzzle 1 solution: " + ++ show (listDistance x y) diff --git a/src/Day1/Puzzle2.hs b/src/Day1/Puzzle2.hs index c34b9cc..dbee072 100644 --- a/src/Day1/Puzzle2.hs +++ b/src/Day1/Puzzle2.hs @@ -2,16 +2,18 @@ module Day1.Puzzle2 (day1_2) where -import Data.List (transpose, sort, group, uncons) +import Data.List (group, sort, transpose, uncons) import Data.Maybe (fromJust) 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 ] +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] day1_2 :: IO () day1_2 = do - contents <- lines <$> readFile "input/day1.txt" - let [x, y] = transpose $ map read . words <$> contents - putStrLn $ "Day 1, Puzzle 2 solution: " - ++ show (similarityScore x y) + contents <- lines <$> readFile "input/day1.txt" + let [x, y] = transpose $ map read . words <$> contents + putStrLn $ + "Day 1, Puzzle 2 solution: " + ++ show (similarityScore x y) diff --git a/src/Day10/Puzzle1.hs b/src/Day10/Puzzle1.hs index aa27429..12a3039 100644 --- a/src/Day10/Puzzle1.hs +++ b/src/Day10/Puzzle1.hs @@ -1,34 +1,37 @@ module Day10.Puzzle1 (day10_1) where import Data.Char (digitToInt) +import Data.Graph (graphFromEdges, path, vertices) import Data.List (uncons) import Data.List.Split (chunksOf) import Data.Maybe (fromJust) -import Data.Graph (graphFromEdges, path, vertices) type Coords = (Int, Int) + type V = (String, Int) getValue :: [[V]] -> Coords -> V getValue grid (i, j) = grid !! i !! j getEdges :: [[V]] -> Coords -> [Int] -getEdges grid (i, j) = let value = fst $ 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) ] - in [ snd x | x <- map (getValue grid) adjI, digitToInt (fst . fromJust $ uncons value) == digitToInt (fst . fromJust $ uncons (fst x)) - 1 ] +getEdges grid (i, j) = + let value = fst $ 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)] + in [snd x | x <- map (getValue grid) adjI, digitToInt (fst . fromJust $ uncons value) == digitToInt (fst . fromJust $ uncons (fst x)) - 1] listVertices :: [String] -> [[V]] -listVertices grid = let l = length $ fst . fromJust $ uncons grid - in chunksOf l $ zip (map (:[]) (concat grid)) [0..] +listVertices grid = + let l = length $ fst . fromJust $ uncons grid + in chunksOf l $ zip (map (: []) (concat grid)) [0 ..] day10_1 :: IO () day10_1 = do - contents <- lines <$> readFile "input/day10.txt" - let grid = listVertices contents - 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) ] - (graph, nodeFromVertex, _) = graphFromEdges edgeList - startList = [ x | (_, x, _) <- filter (\(x, _, _) -> x == "0") $ 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 ] - putStrLn $ "Day 10, Puzzle 1 solution: " ++ show (length paths) + contents <- lines <$> readFile "input/day10.txt" + let grid = listVertices contents + 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)] + (graph, nodeFromVertex, _) = graphFromEdges edgeList + startList = [x | (_, x, _) <- filter (\(x, _, _) -> x == "0") $ 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] + putStrLn $ "Day 10, Puzzle 1 solution: " ++ show (length paths) diff --git a/src/Day11/Puzzle1.hs b/src/Day11/Puzzle1.hs index a474aba..876875e 100644 --- a/src/Day11/Puzzle1.hs +++ b/src/Day11/Puzzle1.hs @@ -4,11 +4,12 @@ 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)] +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 @@ -16,6 +17,7 @@ blink n m = blink (n - 1) $ M.fromListWith (+) $ concatMap blinkStone $ M.toList day11_1 :: IO () day11_1 = do - contents <- M.fromListWith (+) . flip zip (repeat 1) . map read . words <$> readFile "input/day11.txt" - putStrLn $ "Day 11, Puzzle 1 solution: " - ++ show (M.foldl (+) 0 $ blink 25 contents) + contents <- M.fromListWith (+) . flip zip (repeat 1) . map read . words <$> readFile "input/day11.txt" + putStrLn $ + "Day 11, Puzzle 1 solution: " + ++ show (M.foldl (+) 0 $ blink 25 contents) diff --git a/src/Day11/Puzzle2.hs b/src/Day11/Puzzle2.hs index 671aa51..df2d527 100644 --- a/src/Day11/Puzzle2.hs +++ b/src/Day11/Puzzle2.hs @@ -4,11 +4,12 @@ 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)] +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 @@ -16,6 +17,7 @@ blink n m = blink (n - 1) $ M.fromListWith (+) $ concatMap blinkStone $ M.toList 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) + contents <- M.fromListWith (+) . flip zip (repeat 1) . map read . words <$> readFile "input/day11.txt" + putStrLn $ + "Day 11, Puzzle 2 solution: " + ++ show (M.foldl (+) 0 $ blink 75 contents) diff --git a/src/Day12/Puzzle1.hs b/src/Day12/Puzzle1.hs index a1a2b6b..acfaeb0 100644 --- a/src/Day12/Puzzle1.hs +++ b/src/Day12/Puzzle1.hs @@ -1,40 +1,45 @@ module Day12.Puzzle1 (day12_1) where +import Data.Foldable (toList) +import Data.Graph (Tree, Vertex, graphFromEdges, scc) import Data.List (uncons) import Data.List.Split (chunksOf) import Data.Maybe (fromJust) -import Data.Graph (Tree, Vertex, graphFromEdges, scc) -import Data.Foldable (toList) type Coords = (Int, Int) + type V = (String, Int) getValue :: [[V]] -> Coords -> V getValue grid (i, j) = grid !! i !! j getEdges :: [[V]] -> Coords -> [Int] -getEdges grid (i, j) = let value = fst $ 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) ] - in [ snd x | x <- map (getValue grid) adjI, (fst . fromJust $ uncons value) == (fst . fromJust $ uncons (fst x)) ] +getEdges grid (i, j) = + let value = fst $ 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)] + in [snd x | x <- map (getValue grid) adjI, (fst . fromJust $ uncons value) == (fst . fromJust $ uncons (fst x))] listVertices :: [String] -> [[V]] -listVertices grid = let l = length $ fst . fromJust $ uncons grid - in chunksOf l $ zip (map (:[]) (concat grid)) [0..] +listVertices grid = + let l = length $ fst . fromJust $ uncons grid + in chunksOf l $ zip (map (: []) (concat grid)) [0 ..] calculatePerimeter :: (Vertex -> (String, Vertex, [Vertex])) -> Tree Vertex -> Int -calculatePerimeter nodeFromVertex p = let edges = concat [ x | (_, _, x) <- toList $ fmap nodeFromVertex p ] - area = 4 * length p - in area - length edges +calculatePerimeter nodeFromVertex p = + let edges = concat [x | (_, _, x) <- toList $ fmap nodeFromVertex p] + area = 4 * length p + in area - length edges day12_1 :: IO () -day12_1= do - contents <- lines <$> readFile "input/day12.txt" - let grid = listVertices contents - 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) ] - (graph, nodeFromVertex, _) = graphFromEdges edgeList - plots = scc graph - areas = map length plots - perimeters = map (calculatePerimeter nodeFromVertex) plots - putStrLn $ "Day 12, Puzzle 1 solution: " - ++ show (sum $ zipWith (*) areas perimeters) +day12_1 = do + contents <- lines <$> readFile "input/day12.txt" + let grid = listVertices contents + 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)] + (graph, nodeFromVertex, _) = graphFromEdges edgeList + plots = scc graph + areas = map length plots + perimeters = map (calculatePerimeter nodeFromVertex) plots + putStrLn $ + "Day 12, Puzzle 1 solution: " + ++ show (sum $ zipWith (*) areas perimeters) diff --git a/src/Day13/Puzzle1.hs b/src/Day13/Puzzle1.hs index 322e48a..ac26e16 100644 --- a/src/Day13/Puzzle1.hs +++ b/src/Day13/Puzzle1.hs @@ -1,30 +1,33 @@ -{-# OPTIONS_GHC -Wno-type-defaults#-} +{-# OPTIONS_GHC -Wno-type-defaults #-} module Day13.Puzzle1 (day13_1) where 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.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 x = let diff = x - fromInteger (round x) - in abs diff < 0.001 +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] +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 +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 @@ -32,8 +35,9 @@ 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) + contents <- map concat . chunksOf 4 . lines <$> readFile "input/day13.txt" + let eqSystems = map getMatrix contents + solutions = (map . map) round $ mapMaybe solve eqSystems + putStrLn $ + "Day 13, Puzzle 1 solution: " + ++ show (sum $ map cost solutions) diff --git a/src/Day13/Puzzle2.hs b/src/Day13/Puzzle2.hs index 6bd060d..c8599ca 100644 --- a/src/Day13/Puzzle2.hs +++ b/src/Day13/Puzzle2.hs @@ -1,34 +1,37 @@ -{-# OPTIONS_GHC -Wno-type-defaults#-} +{-# OPTIONS_GHC -Wno-type-defaults #-} module Day13.Puzzle2 (day13_2) where 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.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 x = let diff = x - fromInteger (round x) - in abs diff < 0.001 +isAlmostInt x = + let diff = x - fromInteger (round x) + in abs diff < 0.001 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 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 - in fromLists [eq1, eq2] +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 + 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 +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 @@ -36,8 +39,9 @@ cost _ = 0 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) + contents <- map concat . chunksOf 4 . lines <$> readFile "input/day13.txt" + let eqSystems = map getMatrix contents + solutions = (map . map) round $ mapMaybe solve eqSystems + putStrLn $ + "Day 13, Puzzle 2 solution: " + ++ show (sum $ map cost solutions) diff --git a/src/Day14/Puzzle1.hs b/src/Day14/Puzzle1.hs index 077d701..19a1d66 100644 --- a/src/Day14/Puzzle1.hs +++ b/src/Day14/Puzzle1.hs @@ -6,42 +6,52 @@ import Data.Char (isDigit) 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)) +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 :: Int -> Robot -> Robot moveRobot 0 r = r -moveRobot n r = let (px, py) = fst r - (vx, vy) = snd r - in moveRobot (n - 1) (((px + vx) `mod` 101, (py + vy) `mod` 103), (vx, vy)) +moveRobot n r = + let (px, py) = fst r + (vx, vy) = snd r + in moveRobot (n - 1) (((px + vx) `mod` 101, (py + vy) `mod` 103), (vx, vy)) quadrant :: Robot -> Int quadrant r - | fst p `elem` [0..49] && - snd p `elem` [0..50] = 0 - | fst p `elem` [51..100] && - snd p `elem` [0..50] = 1 - | fst p `elem` [0..49] && - snd p `elem` [52..102] = 2 - | fst p `elem` [51..100] && - snd p `elem` [52..102] = 3 - | otherwise = -1 - where p = fst r + | fst p `elem` [0 .. 49] + && snd p `elem` [0 .. 50] = + 0 + | fst p `elem` [51 .. 100] + && snd p `elem` [0 .. 50] = + 1 + | fst p `elem` [0 .. 49] + && snd p `elem` [52 .. 102] = + 2 + | fst p `elem` [51 .. 100] + && snd p `elem` [52 .. 102] = + 3 + | otherwise = -1 + where + p = fst r day14_1 :: IO () -day14_1= do - contents <- lines <$> readFile "input/day14.txt" - let robots = map readRobot contents - robots' = map (moveRobot 100) robots - firstQ = length $ filter (\r -> quadrant r == 0) robots' - secondQ = length $ filter (\r -> quadrant r == 1) robots' - thirdQ = length $ filter (\r -> quadrant r == 2) robots' - fourthQ = length $ filter (\r -> quadrant r == 3) robots' - putStrLn $ "Day 14, Puzzle 1 solution: " - ++ show (firstQ * secondQ * thirdQ * fourthQ) +day14_1 = do + contents <- lines <$> readFile "input/day14.txt" + let robots = map readRobot contents + robots' = map (moveRobot 100) robots + firstQ = length $ filter (\r -> quadrant r == 0) robots' + secondQ = length $ filter (\r -> quadrant r == 1) robots' + thirdQ = length $ filter (\r -> quadrant r == 2) robots' + fourthQ = length $ filter (\r -> quadrant r == 3) robots' + putStrLn $ + "Day 14, Puzzle 1 solution: " + ++ show (firstQ * secondQ * thirdQ * fourthQ) diff --git a/src/Day2/Puzzle1.hs b/src/Day2/Puzzle1.hs index ba9dd33..7907506 100644 --- a/src/Day2/Puzzle1.hs +++ b/src/Day2/Puzzle1.hs @@ -5,13 +5,15 @@ 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) + where + isAscending x = x == sort x + isDescending x = x == sortBy (comparing Down) x + distances = map abs $ zipWith (-) xs (drop 1 xs) day2_1 :: IO () day2_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) + contents <- lines <$> readFile "input/day2.txt" + let reports = map read . words <$> contents + putStrLn $ + "Day 2, Puzzle 1 solution: " + ++ show (length $ filter isSafe reports) diff --git a/src/Day2/Puzzle2.hs b/src/Day2/Puzzle2.hs index 9ecaa23..1ea8565 100644 --- a/src/Day2/Puzzle2.hs +++ b/src/Day2/Puzzle2.hs @@ -1,22 +1,25 @@ module Day2.Puzzle2 (day2_2) where -import Data.List (sort, sortBy, inits, tails) +import Data.List (inits, sort, sortBy, tails) 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) + where + isAscending x = x == sort x + isDescending x = x == sortBy (comparing Down) x + distances = map abs $ zipWith (-) xs (drop 1 xs) removeLevel :: [Int] -> [[Int]] removeLevel xs = zipWith (++) ys zs - where ys = map init $ drop 1 (inits xs) - zs = map (drop 1) $ init (tails xs) + where + ys = map init $ drop 1 (inits xs) + zs = map (drop 1) $ init (tails xs) day2_2 :: IO () day2_2 = do - contents <- lines <$> readFile "input/day2.txt" - let reports = map read . words <$> contents - putStrLn $ "Day 2, Puzzle 2 solution: " - ++ show (length . filter (any isSafe) $ map removeLevel reports) + contents <- lines <$> readFile "input/day2.txt" + let reports = map read . words <$> contents + putStrLn $ + "Day 2, Puzzle 2 solution: " + ++ show (length . filter (any isSafe) $ map removeLevel reports) diff --git a/src/Day3/Puzzle1.hs b/src/Day3/Puzzle1.hs index c91c411..82f6744 100644 --- a/src/Day3/Puzzle1.hs +++ b/src/Day3/Puzzle1.hs @@ -4,12 +4,14 @@ 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 +sumMul xs = + let vals = map (splitOn "," . filter (`elem` "0123456789,")) xs + in sum $ map (product . map read) vals day3_1 :: IO () day3_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) + contents <- readFile "input/day3.txt" + let mults = getAllTextMatches (contents =~ "mul\\([0-9]+,[0-9]+\\)") :: [String] + putStrLn $ + "Day 3, Puzzle 1 solution: " + ++ show (sumMul mults) diff --git a/src/Day3/Puzzle2.hs b/src/Day3/Puzzle2.hs index 7c7003a..3800c21 100644 --- a/src/Day3/Puzzle2.hs +++ b/src/Day3/Puzzle2.hs @@ -5,15 +5,17 @@ import Data.List.Split (split, splitOn, startsWith) 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 +sumMul xs = + let vals = map (splitOn "," . filter (`elem` "0123456789,")) xs + in sum $ map (product . map read) vals 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 - contents <- split (startsWith "don't()") <$> readFile "input/day3.txt" - let mults = getAllTextMatches (filterDonts contents =~ "mul\\([0-9]+,[0-9]+\\)") :: [String] - putStrLn $ "Day 3, Puzzle 2 solution: " - ++ show (sumMul mults) + contents <- split (startsWith "don't()") <$> readFile "input/day3.txt" + let mults = getAllTextMatches (filterDonts contents =~ "mul\\([0-9]+,[0-9]+\\)") :: [String] + putStrLn $ + "Day 3, Puzzle 2 solution: " + ++ show (sumMul mults) diff --git a/src/Day4/Puzzle1.hs b/src/Day4/Puzzle1.hs index aecc32c..65de1eb 100644 --- a/src/Day4/Puzzle1.hs +++ b/src/Day4/Puzzle1.hs @@ -1,25 +1,34 @@ module Day4.Puzzle1 (day4_1) where -import Data.List (transpose, isPrefixOf) +import Data.List (isPrefixOf, 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)) + 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) text) + sum (map (countOccurrences' word . reverse) text) - + sum (map (countOccurrences' word) cols) + sum (map (countOccurrences' word . reverse) cols) - + sum (map (countOccurrences' word) diags) + sum (map (countOccurrences' word . reverse) diags) - where 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 +countOccurrences word text = + sum (map (countOccurrences' word) text) + + sum (map (countOccurrences' word . reverse) text) + + sum (map (countOccurrences' word) cols) + + sum (map (countOccurrences' word . reverse) cols) + + sum (map (countOccurrences' word) diags) + + sum (map (countOccurrences' word . reverse) diags) + where + 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 = do - contents <- lines <$> readFile "input/day4.txt" - putStrLn $ "Day 4, Puzzle 1 solution: " - ++ show (countOccurrences "XMAS" contents) + contents <- lines <$> readFile "input/day4.txt" + putStrLn $ + "Day 4, Puzzle 1 solution: " + ++ show (countOccurrences "XMAS" contents) diff --git a/src/Day4/Puzzle2.hs b/src/Day4/Puzzle2.hs index 2f4e94b..8db1661 100644 --- a/src/Day4/Puzzle2.hs +++ b/src/Day4/Puzzle2.hs @@ -1,29 +1,34 @@ module Day4.Puzzle2 (day4_2) where -import Data.List (transpose, isPrefixOf, tails) +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)) + 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 + 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] +submatricesVert n matrix@(_ : xxs) = submatrix matrix ++ submatricesVert n xxs + where + submatrix m = [take n $ map (take n) m] day4_2 :: IO () day4_2 = do - contents <- lines <$> readFile "input/day4.txt" - let xmas = length . filter (\x -> countOccurrences "MAS" x == 2) . concatMap (submatricesVert 3) . transpose $ map tails contents - putStrLn $ "Day 4, Puzzle 2 solution: " ++ show xmas + contents <- lines <$> readFile "input/day4.txt" + let xmas = length . concatMap (filter (\x -> countOccurrences "MAS" x == 2) . submatricesVert 3) . transpose $ map tails contents + putStrLn $ "Day 4, Puzzle 2 solution: " ++ show xmas diff --git a/src/Day5/Puzzle1.hs b/src/Day5/Puzzle1.hs index 2ee65cb..0dfdccb 100644 --- a/src/Day5/Puzzle1.hs +++ b/src/Day5/Puzzle1.hs @@ -6,17 +6,19 @@ 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 +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) day5_1 :: IO () day5_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) + contents <- map (splitOn "|") . lines <$> readFile "input/day5.txt" + let rules = [(x, y) | [x, y] <- takeWhile (/= [""]) contents] + updates = concatMap (map (splitOn ",")) . drop 1 $ dropWhile (/= [""]) contents + sorted = filter (isSorted rules) updates + putStrLn $ + "Day 5, Puzzle 1 solution: " + ++ (show :: Int -> String) (sum $ map (read . getMiddle) sorted) diff --git a/src/Day5/Puzzle2.hs b/src/Day5/Puzzle2.hs index faf32d6..cb63cd7 100644 --- a/src/Day5/Puzzle2.hs +++ b/src/Day5/Puzzle2.hs @@ -7,24 +7,27 @@ 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 +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 :: [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 ] +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] day5_2 :: IO () day5_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) + contents <- map (splitOn "|") . lines <$> readFile "input/day5.txt" + let rules = [(read x, read y) | [x, y] <- takeWhile (/= [""]) contents] + unsorted = filter (not . isSorted rules) . map (map read) $ concatMap (map (splitOn ",")) . drop 1 $ dropWhile (/= [""]) contents + fixUnsorted = map (sortOnRules rules) unsorted + putStrLn $ + "Day 5, Puzzle 2 solution: " + ++ show (sum $ map getMiddle fixUnsorted) diff --git a/src/Day6/Puzzle1.hs b/src/Day6/Puzzle1.hs index 1cdf210..a0d2bf1 100644 --- a/src/Day6/Puzzle1.hs +++ b/src/Day6/Puzzle1.hs @@ -1,11 +1,13 @@ module Day6.Puzzle1 (day6_1) where import Data.List (elemIndex, uncons) -import Data.Maybe (isJust, fromMaybe, fromJust) +import Data.Maybe (fromJust, fromMaybe, isJust) type Grid = [String] + 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 '^' = Just U @@ -14,10 +16,11 @@ getDirection 'v' = Just D getDirection '<' = Just L getDirection _ = Nothing -getStartPosition:: Char -> Grid -> Position +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 + 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 @@ -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) 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) +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 +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 +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 day6_1 :: IO () day6_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 . filter (== 'X') . concat $ visitGrid (x, y) direction contents) + contents <- lines <$> readFile "input/day6.txt" + let (x, y) = + (\a b c d -> fst . fromJust $ uncons $ filter ((>= 0) . fst) [a, b, c, d]) + <$> getStartPosition 'v' + <*> getStartPosition '^' + <*> getStartPosition '<' + <*> getStartPosition '>' + $ contents + direction = fromJust . getDirection $ (contents !! x) !! y + putStrLn $ + "Day 6, Puzzle 1 solution: " + ++ show (length . concatMap (filter (== 'X')) $ visitGrid (x, y) direction contents) diff --git a/src/Day6/Puzzle2.hs b/src/Day6/Puzzle2.hs index e216ee3..058f5ae 100644 --- a/src/Day6/Puzzle2.hs +++ b/src/Day6/Puzzle2.hs @@ -1,11 +1,13 @@ module Day6.Puzzle2 (day6_2) where import Data.List (elemIndex, uncons) -import Data.Maybe (isJust, fromMaybe, fromJust) +import Data.Maybe (fromJust, fromMaybe, isJust) type Grid = [String] + 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 '^' = Just U @@ -22,8 +24,9 @@ printDirection L = '<' 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 + 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 @@ -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) 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) +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 gridVal = getGridVal (x, y) grid - in if gridVal == '#' || gridVal == '^' || gridVal == '>' || gridVal == 'v' || gridVal == '<' - then grid - else let row = grid !! x - newRow = take y row ++ [c] ++ drop (y + 1) row - in take x grid ++ [newRow] ++ drop (x + 1) grid +markVisited (x, y) c grid = + let gridVal = getGridVal (x, y) grid + in if gridVal == '#' || gridVal == '^' || gridVal == '>' || gridVal == 'v' || gridVal == '<' + then grid + else + 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 +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 checkGridLoop :: Position -> Direction -> Grid -> Bool -checkGridLoop startPosition direction grid = let (nextPosition, newDirection) = getNextPosition startPosition direction grid - newDirectionChar = printDirection newDirection - newGrid = markVisited nextPosition newDirectionChar grid - in (nextPosition `isInside` grid) - && ((getGridVal nextPosition grid == newDirectionChar) - || checkGridLoop nextPosition newDirection newGrid) +checkGridLoop startPosition direction grid = + let (nextPosition, newDirection) = getNextPosition startPosition direction grid + newDirectionChar = printDirection newDirection + newGrid = markVisited nextPosition newDirectionChar grid + in (nextPosition `isInside` grid) + && ( (getGridVal nextPosition grid == newDirectionChar) + || checkGridLoop nextPosition newDirection newGrid + ) 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' ] - in zipWith (`markVisited` '#') positions (replicate (length positions) 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'] + in zipWith (`markVisited` '#') positions (replicate (length positions) grid) + day6_2 :: IO () day6_2 = 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 - 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) + 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 + 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) diff --git a/src/Day7/Puzzle1.hs b/src/Day7/Puzzle1.hs index 7767bc0..8c13983 100644 --- a/src/Day7/Puzzle1.hs +++ b/src/Day7/Puzzle1.hs @@ -8,16 +8,18 @@ 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) +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) day7_1 :: IO () day7_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) + [x, y] <- transpose . map (splitOn ":") . lines <$> readFile "input/day7.txt" + let results = map read x + values = map read <$> map words y + equations = zip results values + putStrLn $ + "Day 7, Puzzle 1 solution: " + ++ show (sum . map fst $ filter (isSolvable 0) equations) diff --git a/src/Day7/Puzzle2.hs b/src/Day7/Puzzle2.hs index 43d33f5..855dc78 100644 --- a/src/Day7/Puzzle2.hs +++ b/src/Day7/Puzzle2.hs @@ -11,21 +11,23 @@ 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) +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) day7_2 :: IO () day7_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) + [x, y] <- transpose . map (splitOn ":") . lines <$> readFile "input/day7.txt" + let results = map read x + values = map read <$> map words y + equations = zip results values + putStrLn $ + "Day 7, Puzzle 2 solution: " + ++ show (sum . map fst $ filter (isSolvable 0) equations) diff --git a/src/Day8/Puzzle1.hs b/src/Day8/Puzzle1.hs index 02b3b47..3125efd 100644 --- a/src/Day8/Puzzle1.hs +++ b/src/Day8/Puzzle1.hs @@ -1,40 +1,46 @@ module Day8.Puzzle1 (day8_1) where +import Control.Applicative import Data.List (uncons) import Data.Maybe (fromJust) -import Control.Applicative import qualified Data.Set as Set type Freq = Char + type Coords = (Int, Int) -data Antenna = Antenna { frequency :: Freq - , coordinates :: Coords - } deriving (Show, Eq) + +data Antenna = Antenna + { frequency :: Freq, + coordinates :: Coords + } + deriving (Show, Eq) readAntenna :: Freq -> Coords -> Antenna -readAntenna freq coords = Antenna {frequency=freq, coordinates=coords} +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 /= '.' ] +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)] +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)] day8_1 :: IO () day8_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) + contents <- lines <$> readFile "input/day8.txt" + let antennas = getAntennas contents + x = length contents + y = length $ fst . fromJust $ uncons contents + antinodes = Set.fromList $ concat [getAntinodes a b x y | a <- antennas, b <- antennas, a /= b, frequency a == frequency b] + putStrLn $ "Day 8, Puzzle 1 solution: " ++ show (length antinodes) diff --git a/src/Day8/Puzzle2.hs b/src/Day8/Puzzle2.hs index b699544..fcf86b5 100644 --- a/src/Day8/Puzzle2.hs +++ b/src/Day8/Puzzle2.hs @@ -1,49 +1,57 @@ module Day8.Puzzle2 (day8_2) where +import Control.Applicative +import Data.Bifunctor (bimap) import Data.List (uncons) import Data.Maybe (fromJust) -import Control.Applicative import Data.Set (fromList) -import Data.Bifunctor (bimap) type Freq = Char + type Coords = (Int, Int) -data Antenna = Antenna { frequency :: Freq - , coordinates :: Coords - } deriving (Show, Eq) + +data Antenna = Antenna + { frequency :: Freq, + coordinates :: Coords + } + deriving (Show, Eq) readAntenna :: Freq -> Coords -> Antenna -readAntenna freq coords = Antenna {frequency=freq, coordinates=coords} +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 /= '.' ] +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 generateCoords :: Coords -> Coords -> [Coords] 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 a b maxX maxY = let xa = fst $ coordinates a - ya = snd $ coordinates a - xb = fst $ coordinates b - yb = snd $ coordinates b - distX = xa - xb - distY = ya - yb - 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)] - ++ takeWhile (\c -> isInside c maxX maxY) (generateCoords (coordinates a) (distX, distY)) - ++ takeWhile (\c -> isInside c maxX maxY) (generateCoords (coordinates b) (-distX, -distY)) +getAntinodes a b maxX maxY = + let xa = fst $ coordinates a + ya = snd $ coordinates a + xb = fst $ coordinates b + yb = snd $ coordinates b + distX = xa - xb + distY = ya - yb + 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)] + ++ 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 = 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 2 solution: " ++ show (length antinodes) + 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 2 solution: " ++ show (length antinodes) diff --git a/src/Day9/Puzzle1.hs b/src/Day9/Puzzle1.hs index 969960e..ffe4a2c 100644 --- a/src/Day9/Puzzle1.hs +++ b/src/Day9/Puzzle1.hs @@ -1,31 +1,34 @@ module Day9.Puzzle1 (day9_1) where -import Data.List (intersperse) +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 -import qualified Data.Foldable as F -import Control.Applicative parseDiskMap :: [Int] -> S.Seq Int -parseDiskMap xs = let values = intersperse (-1) [0..] - in S.fromList . concat . getZipList $ replicate <$> ZipList xs <*> ZipList values +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 + | 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..] +checksum xs = sum $ zipWith (*) xs [0 ..] day9_1 :: IO () day9_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) + contents <- init <$> readFile "input/day9.txt" + let diskMap = map digitToInt contents + putStrLn $ + "Day 9, Puzzle 1 solution: " + ++ show (checksum . F.toList . compact $ parseDiskMap diskMap) diff --git a/src/Day9/Puzzle2.hs b/src/Day9/Puzzle2.hs index bbe1f54..04d152c 100644 --- a/src/Day9/Puzzle2.hs +++ b/src/Day9/Puzzle2.hs @@ -2,18 +2,19 @@ module Day9.Puzzle2 (day9_2) where -import Data.List (intersperse, groupBy) 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 Data.Function (on) +import Data.List (groupBy, intersperse) +import Data.Maybe (fromMaybe) +import qualified Data.Sequence as S type DiskElem = (Int, Int) parseDiskMap :: [Int] -> S.Seq DiskElem -parseDiskMap xs = let values = intersperse (-1) [0..] - in S.fromList $ zip values xs +parseDiskMap xs = + let values = intersperse (-1) [0 ..] + in S.fromList $ zip values xs isSpaceEnough :: Int -> DiskElem -> Bool isSpaceEnough n (-1, l) = l >= n @@ -29,38 +30,42 @@ compareFileValue :: Int -> DiskElem -> Bool compareFileValue x (v, _) = x == v 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 - in S.fromList $ map (foldl1 combineSpace) $ groupBy ((==) `on` fst) xs' +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 + in S.fromList $ map (foldl1 combineSpace) $ groupBy ((==) `on` fst) xs' compactFiles :: Int -> S.Seq DiskElem -> S.Seq DiskElem compactFiles (-1) xs = xs compactFiles 0 xs = xs -compactFiles n xs = if fst fVal == -1 || sIndex == -1 || sIndex >= n - then compactFiles (n - 1) xs - else compactFiles fIndex xs' - where fVal = S.index xs n - sIndex = fromMaybe (-1) $ S.findIndexL (isSpaceEnough (snd fVal)) 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' +compactFiles n xs = + if fst fVal == -1 || sIndex == -1 || sIndex >= n + then compactFiles (n - 1) xs + else compactFiles fIndex xs' + where + fVal = S.index xs n + sIndex = fromMaybe (-1) $ S.findIndexL (isSpaceEnough (snd fVal)) 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 [] = [] -maskMinus1 (l:ls) - | l == -1 = 0:maskMinus1 ls - | otherwise = l:maskMinus1 ls +maskMinus1 (l : ls) + | l == -1 = 0 : maskMinus1 ls + | otherwise = l : maskMinus1 ls tuplesToIntList :: S.Seq DiskElem -> [Int] -tuplesToIntList disk = let listDisk = F.toList disk - in concatMap (\x -> replicate (snd x) (fst x)) listDisk +tuplesToIntList disk = + let listDisk = F.toList disk + in concatMap (\x -> replicate (snd x) (fst x)) listDisk checksum :: [Int] -> Int -checksum xs = sum $ zipWith (*) (maskMinus1 xs) [0..] +checksum xs = sum $ zipWith (*) (maskMinus1 xs) [0 ..] day9_2 :: IO () day9_2 = do - contents <- init <$> readFile "input/day9.txt" - 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) + contents <- init <$> readFile "input/day9.txt" + 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)