Finish Day 2 - Part 2

src/advent_of_code/2023/2.hs

@@ -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]
+example :: [Text]
-example1 =
+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"