Advent of Code, 2024 - Day 2 Part 2

src/advent_of_code/2024/2.hs

@@ -2,7 +2,9 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 
-import           Data.List    hiding (lines)
+import           Data.List    (all, drop, elem, filter, length, map, or, sort,
+                               sortOn, tail, take, zipWith)
+import           Data.Ord     (Down (Down), Ord ((<=), (>=)))
 import           Data.Text    (Text, lines, pack, splitOn, unpack)
 import           Data.Text.IO (readFile)
 import           GHC.IO       (unsafePerformIO)
@@ -26,31 +28,24 @@ main = do
   print $ "Part 2: " <> show (solveP2 entries)
 
 solveP1 :: [[Int]] -> Int
-solveP1 = length . filter (== True) . map safeReport
-
-safeReport :: [Int] -> Bool
-safeReport report = isSorted && adjacentLevelCheck
-  where
-    isSorted = sortedReportASC == report || sortedReportDESC == report
-    sortedReportASC = sort report
-    sortedReportDESC = reverse sortedReportASC
-
-    adjacentLevelCheck =
-      all (((== True) . (\n-> n>=1 && n<=3)) . abs)
-          (zipWith subtract report (tail report))
-
+solveP1 = length . filter (== True) . map safeReportP1
 
 solveP2 :: [[Int]] -> Int
-solveP2 = length . filter (== True) . map safeReport'
+solveP2 = length . filter (== True) . map safeReportP2
 
-safeReport' :: [Int] -> Bool
-safeReport' report =
-  or $ zipWith (&&) (map adjacentLevelCheck reports) (map isSorted reports)
-  where
-    isSorted report = report `elem` [sort report, reverse (sort report)]
+safeReportP1 :: [Int] -> Bool
+safeReportP1 report = isSorted report && adjacentLevelCheck report
 
+isSorted :: [Int] -> Bool
+isSorted report = report `elem` [sort report, sortOn Down report]
+
+adjacentLevelCheck :: [Int] -> Bool
 adjacentLevelCheck report =
   all (((== True) . (\n-> n>=1 && n<=3)) . abs)
       (zipWith subtract report (tail report))
 
-    reports = map tail $ permutations report
+safeReportP2 :: [Int] -> Bool
+safeReportP2 report = any safeReportP1 (removeOneBadReport report)
+
+removeOneBadReport :: [Int] -> [[Int]]
+removeOneBadReport lst = map (\i -> take i lst <> drop (succ i) lst) [0..length lst-1]