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

16
src/Day1/Puzzle2.hs
View File

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

33
src/Day10/Puzzle1.hs
View File

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

18
src/Day11/Puzzle1.hs
View File

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

18
src/Day11/Puzzle2.hs
View File

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

47
src/Day12/Puzzle1.hs
View File

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

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

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

64
src/Day14/Puzzle1.hs
View File

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

16
src/Day2/Puzzle1.hs
View File

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

23
src/Day2/Puzzle2.hs
View File

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

14
src/Day3/Puzzle1.hs
View File

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

18
src/Day3/Puzzle2.hs
View File

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

39
src/Day4/Puzzle1.hs
View File

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

31
src/Day4/Puzzle2.hs
View File

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

18
src/Day5/Puzzle1.hs
View File

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

29
src/Day5/Puzzle2.hs
View File

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

93
src/Day6/Puzzle1.hs
View File

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

122
src/Day6/Puzzle2.hs
View File

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

22
src/Day7/Puzzle1.hs
View File

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

32
src/Day7/Puzzle2.hs
View File

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

46
src/Day8/Puzzle1.hs
View File

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

60
src/Day8/Puzzle2.hs
View File

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

35
src/Day9/Puzzle1.hs
View File

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

59
src/Day9/Puzzle2.hs
View File

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