1
0
Fork 0

Finish Day 2 - Part 2

Bill Ewanick 2023-12-06 15:15:14 -05:00
parent 29c5ea7841
commit 226397fd99
1 changed files with 50 additions and 4 deletions

View File

@ -14,7 +14,7 @@ main = do
putStrLn "Advent of Code 2023 - Day 2"
-- print entries
putStrLn ("Part 1: " <> show (solveP1 entries))
-- putStrLn ("Part 2: " <> show (solveP2 entries))
putStrLn ("Part 2: " <> show (solveP2 entries))
--
-- Part 1
@ -48,7 +48,53 @@ solveP1 = sum . map fst . filter snd . map (second (all (== True) . concatMap (m
-- Part 2
--
solveP2 = id
solveP2 :: [Text] -> Int
solveP2 = sumOfPowerCubes . allMinCubes . parsedEntries
parsedEntries :: [Text] -> [[[Cube Colour Int]]]
parsedEntries = map (snd . parseInput)
allMinCubes :: [[[Cube Colour Int]]] -> [(Cube Colour Int, Cube Colour Int, Cube Colour Int)]
allMinCubes = map findMinimumCubes
where
findMinimumCubes :: [[Cube Colour Int]] -> (Cube Colour Int, Cube Colour Int, Cube Colour Int)
findMinimumCubes = foldl' (compareRGBCubes (>)) cubeMempty . map (foldl' minimumCubesRequired cubeMempty)
sumOfPowerCubes :: [(Cube Colour Int, Cube Colour Int, Cube Colour Int)] -> Int
sumOfPowerCubes = sum . map powerCube
where
powerCube :: (Cube Colour Int, Cube Colour Int, Cube Colour Int) -> Int
powerCube (r,g,b) = n
where
r' = cubeVal r
g' = cubeVal g
b' = cubeVal b
n = r' * g' * b'
minimumCubesRequired
:: (Cube Colour Int, Cube Colour Int, Cube Colour Int)
-> Cube Colour Int
-> (Cube Colour Int, Cube Colour Int, Cube Colour Int)
minimumCubesRequired (r,g,b) (Cube Red n) = if n > cubeVal r then (Cube Red n,g,b ) else (r,g,b)
minimumCubesRequired (r,g,b) (Cube Green n) = if n > cubeVal g then (r,Cube Green n,b) else (r,g,b)
minimumCubesRequired (r,g,b) (Cube Blue n) = if n > cubeVal b then (r,g,Cube Blue n ) else (r,g,b)
compareRGBCubes
:: (Int -> Int -> Bool)
-> (Cube Colour Int, Cube Colour Int, Cube Colour Int)
-> (Cube Colour Int, Cube Colour Int, Cube Colour Int)
-> (Cube Colour Int, Cube Colour Int, Cube Colour Int)
compareRGBCubes f (h,i,j) (k,l,m) = (r,g,b)
where
r = if cubeVal h `f` cubeVal k then h else k
g = if cubeVal i `f` cubeVal l then i else l
b = if cubeVal j `f` cubeVal m then j else m
cubeMempty :: (Cube Colour Int, Cube Colour Int, Cube Colour Int)
cubeMempty = (Cube Red 0, Cube Green 0, Cube Blue 0)
cubeVal :: Cube Colour Int -> Int
cubeVal (Cube _ n) = n
--
-- Parsing
@ -68,8 +114,8 @@ stringToCube str = read $ "Cube " <> colour' <> " " <> n'
-- Examples
--
example1 :: [Text]
example1 =
example :: [Text]
example =
[ "Game 1: 3 blue, 4 red; 1 red, 2 green, 6 blue; 2 green"
, "Game 2: 1 blue, 2 green; 3 green, 4 blue, 1 red; 1 green, 1 blue"
, "Game 3: 8 green, 6 blue, 20 red; 5 blue, 4 red, 13 green; 5 green, 1 red"