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

Improve some code

Browse Source
This commit is contained in:
daniele 2024-12-23 19:00:08 +01:00
parent 588b1e212f
commit a3eab35785
Signed by: fuxino
GPG Key ID: 981A2B2A3BBF5514
7 changed files with 36 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Day01.hs
View File

@ -1,4 +1,4 @@
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-x-partial #-}
module Day01
( day01_1,
@ -6,15 +6,14 @@ module Day01
)
where
import Data.List (group, sort, transpose, uncons)
import Data.Maybe (fromJust)
import Data.List (group, sort, transpose)
listDistance :: [Int] -> [Int] -> Int
listDistance xs ys = sum $ map abs $ zipWith (-) (sort xs) (sort ys)
similarityScore :: [Int] -> [Int] -> Int
similarityScore xs ys =
let elemsY = [(fst . fromJust $ uncons y, length y) | y <- (group . sort) ys]
let elemsY = [(head y, length y) | y <- (group . sort) ys]
in sum [x * snd y | x <- xs, y <- elemsY, x == fst y]
parseInput :: IO [[Int]]

16
src/Day06.hs
View File

@ -1,10 +1,12 @@
{-# OPTIONS_GHC -Wno-x-partial #-}
module Day06
( day06_1,
day06_2,
)
where
import Data.List (elemIndex, uncons)
import Data.List (elemIndex)
import Data.Maybe (fromJust, fromMaybe, isJust)
type Grid = [String]
@ -36,7 +38,7 @@ getGridVal :: Position -> Grid -> Char
getGridVal (x, y) grid = (grid !! x) !! y
isInside :: Position -> Grid -> Bool
isInside (x, y) grid = x >= 0 && y >= 0 && x < length grid && y < length (fst . fromJust $ uncons grid)
isInside (x, y) grid = x >= 0 && y >= 0 && x < length grid && y < length (head grid)
getNextPosition :: Position -> Direction -> Grid -> (Position, Direction)
getNextPosition (x, y) U grid =
@ -64,12 +66,6 @@ getNextPosition (x, y) L grid =
then getNextPosition (x, y) U grid
else (newPos, L)
-- markVisited :: Position -> Char -> Grid -> Grid
-- markVisited (x, y) c grid =
-- let row = grid !! x
-- newRow = take y row ++ [c] ++ drop (y + 1) row
-- in take x grid ++ [newRow] ++ drop (x + 1) grid
--
markVisited :: Position -> Char -> Grid -> Grid
markVisited (x, y) c grid =
let gridVal = getGridVal (x, y) grid
@ -100,14 +96,14 @@ checkGridLoop startPosition direction grid =
setGridObstacles :: Position -> Grid -> [Grid]
setGridObstacles startPosition grid =
let positions = [(x, y) | x <- [0 .. (length grid - 1)], y <- [0 .. (length (fst . fromJust $ uncons grid) - 1)], (x, y) /= startPosition, getGridVal (x, y) grid == 'X']
let positions = [(x, y) | x <- [0 .. (length grid - 1)], y <- [0 .. (length (head grid) - 1)], (x, y) /= startPosition, getGridVal (x, y) grid == 'X']
in zipWith (`markVisited` '#') positions (replicate (length positions) grid)
parseInput :: IO (Int, Int, Direction, [String])
parseInput = do
contents <- lines <$> readFile "input/day6.txt"
let (x, y) =
(\a b c d -> fst . fromJust . uncons $ filter ((>= 0) . fst) [a, b, c, d])
(\a b c d -> head $ filter ((>= 0) . fst) [a, b, c, d])
<$> getStartPosition 'v'
<*> getStartPosition '^'
<*> getStartPosition '<'

6
src/Day08.hs
View File

@ -1,3 +1,5 @@
{-# OPTIONS_GHC -Wno-x-partial #-}
module Day08
( day08_1,
day08_2,
@ -6,8 +8,6 @@ where
import Control.Applicative
import Data.Bifunctor (bimap)
import Data.List (uncons)
import Data.Maybe (fromJust)
import Data.Set (fromList)
type Freq = Char
@ -66,7 +66,7 @@ parseInput = do
contents <- lines <$> readFile "input/day8.txt"
let antennas = getAntennas contents
x = length contents
y = length $ fst . fromJust $ uncons contents
y = length $ head contents
return (x, y, antennas)
day08_1 :: IO ()

12
src/Day12.hs
View File

@ -1,10 +1,10 @@
{-# OPTIONS_GHC -Wno-x-partial #-}
module Day12 (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)
type Coords = (Int, Int)
@ -16,12 +16,12 @@ 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))]
adjI = filter (\x -> fst x >= 0 && fst x < length grid && snd x >= 0 && snd x < length (head grid)) [(i, j + 1), (i + 1, j), (i, j - 1), (i - 1, j)]
in [snd x | x <- map (getValue grid) adjI, head value == head (fst x)]
listVertices :: [String] -> [[V]]
listVertices grid =
let l = length $ fst . fromJust $ uncons grid
let l = length $ head grid
in chunksOf l $ zip (map (: []) (concat grid)) [0 ..]
calculatePerimeter :: (Vertex -> (String, Vertex, [Vertex])) -> Tree Vertex -> Int
@ -34,7 +34,7 @@ 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]]
edgeCoords = [(x, y) | x <- [0 .. length grid - 1], y <- [0 .. length (head grid) - 1]]
edgeList = [(x, y, z) | ((x, y), z) <- zip (concat grid) (map (getEdges grid) edgeCoords)]
(graph, nodeFromVertex, _) = graphFromEdges edgeList
plots = scc graph

9
src/Day13.hs
View File

@ -1,4 +1,4 @@
{-# OPTIONS_GHC -Wno-type-defaults #-}
{-# OPTIONS_GHC -Wno-type-defaults -Wno-x-partial #-}
module Day13
( day13_1,
@ -8,10 +8,9 @@ where
import Data.Char (isDigit)
import Data.Either (fromRight)
import Data.List (uncons)
import Data.List.Split (chunksOf, splitOn)
import Data.Matrix (Matrix, fromLists, rref, toList, zero)
import Data.Maybe (fromJust, mapMaybe)
import Data.Maybe (mapMaybe)
isAlmostInt :: (RealFrac a) => a -> Bool
isAlmostInt x =
@ -25,14 +24,14 @@ multRes xs = xs
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
eq1 = map head nValues
eq2 = map last nValues
in fromLists [eq1, eq2]
getMatrix' :: (Num a, Read a) => String -> Matrix a
getMatrix' s =
let nValues = map (map read . splitOn ",") . splitOn ":" . drop 1 $ filter (\x -> isDigit x || x == ',' || x == ':') s
eq1 = multRes $ map (fst . fromJust . uncons) nValues
eq1 = multRes $ map head nValues
eq2 = multRes $ map last nValues
in fromLists [eq1, eq2]

22
src/Day15.hs
View File

@ -1,8 +1,8 @@
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-x-partial #-}
module Day15 (day15_1) where
import Data.List (elemIndex, elemIndices, transpose, uncons)
import Data.List (elemIndex, elemIndices, transpose)
import Data.List.Split (splitOn)
import Data.Maybe (fromJust, fromMaybe, isJust)
@ -70,8 +70,8 @@ shiftUp p1 grid =
then markPosition p1 '.' (markPosition p2 '@' (markPosition p3 'O' grid))
else
let column = reverse $ transpose grid !! snd p1
nextDot = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< length column - fst p1) $ elemIndices '.' column
nextHash = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< length column - fst p1) $ elemIndices '#' column
nextDot = head $ dropWhile (< length column - fst p1) $ elemIndices '.' column
nextHash = head $ dropWhile (< length column - fst p1) $ elemIndices '#' column
in if nextDot == -1 || nextDot > nextHash
then grid
else markPosition p1 '.' (markPosition p2 '@' (markPosition (length column - 1 - nextDot, snd p1) 'O' grid))
@ -88,8 +88,8 @@ shiftRight p1 grid =
then markPosition p1 '.' (markPosition p2 '@' (markPosition p3 'O' grid))
else
let row = grid !! fst p1
nextDot = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< snd p1) $ elemIndices '.' row
nextHash = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< snd p1) $ elemIndices '#' row
nextDot = head $ dropWhile (< snd p1) $ elemIndices '.' row
nextHash = head $ dropWhile (< snd p1) $ elemIndices '#' row
in if nextDot == -1 || nextDot > nextHash
then grid
else markPosition p1 '.' (markPosition p2 '@' (markPosition (fst p1, nextDot) 'O' grid))
@ -106,8 +106,8 @@ shiftDown p1 grid =
then markPosition p1 '.' (markPosition p2 '@' (markPosition p3 'O' grid))
else
let column = transpose grid !! snd p1
nextDot = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< fst p1) $ elemIndices '.' column
nextHash = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< fst p1) $ elemIndices '#' column
nextDot = head $ dropWhile (< fst p1) $ elemIndices '.' column
nextHash = head $ dropWhile (< fst p1) $ elemIndices '#' column
in if nextDot == -1 || nextDot > nextHash
then grid
else markPosition p1 '.' (markPosition p2 '@' (markPosition (nextDot, snd p1) 'O' grid))
@ -124,8 +124,8 @@ shiftLeft p1 grid =
then markPosition p1 '.' (markPosition p2 '@' (markPosition p3 'O' grid))
else
let row = reverse $ grid !! fst p1
nextDot = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< length row - snd p1) $ elemIndices '.' row
nextHash = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< length row - snd p1) $ elemIndices '#' row
nextDot = head $ dropWhile (< length row - snd p1) $ elemIndices '.' row
nextHash = head $ dropWhile (< length row - snd p1) $ elemIndices '#' row
in if nextDot == -1 || nextDot > nextHash
then grid
else markPosition p1 '.' (markPosition p2 '@' (markPosition (fst p1, length row - 1 - nextDot) 'O' grid))
@ -195,7 +195,7 @@ gpsCoords (x, y) = 100 * x + y
boxCoords :: Grid -> [Int]
boxCoords grid =
let coords = [(x, y) | x <- [0 .. length grid - 1], y <- [0 .. length (fst . fromJust $ uncons grid) - 1], getGridVal (x, y) grid == 'O']
let coords = [(x, y) | x <- [0 .. length grid - 1], y <- [0 .. length (head grid) - 1], getGridVal (x, y) grid == 'O']
in map gpsCoords coords
day15_1 :: IO ()

9
src/Day17.hs
View File

@ -1,14 +1,11 @@
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-type-defaults -Wno-x-partial #-}
module Day17 (day17_1, day17_2) where
import Control.Monad.State
import Data.Bits
import Data.Char (isDigit)
import Data.List (uncons)
import Data.List.Split (splitOn)
import Data.Maybe (fromJust)
type Program = [Int]
@ -132,7 +129,7 @@ parseInput = do
day17_1 :: IO ()
day17_1 = do
(registers, prog) <- parseInput
let computer = Computer {registerA = fst . fromJust $ uncons registers, registerB = registers !! 1, registerC = registers !! 2, pointer = 0, program = prog, output = ""}
let computer = Computer {registerA = head registers, registerB = registers !! 1, registerC = registers !! 2, pointer = 0, program = prog, output = ""}
putStr "Day 17, Puzzle 1 solution: "
print . drop 1 . output $ execState runProgram computer
@ -143,4 +140,4 @@ day17_2 = do
regA = [805464 * 2 ^ 27 ..] -- Threshold derived empirically, a better threshold must be possible because this is very slow, but got the correct answer.
putStrLn $
"Day 17, Puzzle 2 solution: "
++ show (fst . fromJust . uncons $ dropWhile (\x -> not (checkIfCreatesCopy computer {registerA = x})) regA)
++ show (head $ dropWhile (\x -> not (checkIfCreatesCopy computer {registerA = x})) regA)