Day5.hs (6721B)
1 module Day5 (solution) where 2 3 import Utils (SolType(..), safeRead) 4 5 import Control.Monad (liftM, join) 6 import GHC.Num (integerToInt) 7 import Data.Maybe (catMaybes) 8 import Data.List (sortBy, nub) 9 import Debug.Trace (trace) 10 11 input :: IO String 12 input = readFile "inputs/day5" 13 14 exampleInput = join 15 [ "47|53\n" 16 , "97|13\n" 17 , "97|61\n" 18 , "97|47\n" 19 , "75|29\n" 20 , "61|13\n" 21 , "75|53\n" 22 , "29|13\n" 23 , "97|29\n" 24 , "53|29\n" 25 , "61|53\n" 26 , "97|53\n" 27 , "61|29\n" 28 , "47|13\n" 29 , "75|47\n" 30 , "97|75\n" 31 , "47|61\n" 32 , "75|61\n" 33 , "47|29\n" 34 , "75|13\n" 35 , "53|13\n" 36 , "\n" 37 , "75,47,61,53,29\n" 38 , "97,61,53,29,13\n" 39 , "75,29,13\n" 40 , "75,97,47,61,53\n" 41 , "61,13,29\n" 42 , "97,13,75,29,47\n" 43 ] 44 45 type Rule = (Integer, Integer) 46 type Update = [Integer] 47 48 contains :: Eq a => a -> [a] -> Bool 49 contains a (b:bs) 50 | a == b = True 51 | otherwise = contains a bs 52 contains _ [] = False 53 54 replace :: Eq a => a -> a -> [a] -> [a] 55 replace = helper [] 56 where 57 helper :: Eq a => [a] -> a -> a -> [a] -> [a] 58 helper acc og repl (x:xs) 59 | x == og = helper (repl:acc) og repl xs 60 | otherwise = helper (x:acc) og repl xs 61 helper acc _ _ [] = reverse acc 62 63 safeTuple :: Maybe [a] -> Maybe (a, a) 64 safeTuple (Just (a:b:_)) = Just (a,b) 65 safeTuple _ = Nothing 66 67 -- | Parse the puzzle input string into a list of either rules or updates 68 -- Example: 69 -- >>> parse "42|13" 70 -- [Left (42,13)] 71 -- >>> parse "61,13,29" 72 -- [Right [61,13,29]] 73 -- >>> parse "61,13,29\n51,13,29" 74 -- [Right [61,13,29],Right [51,13,29]] 75 -- >>> parse "42|13\n\n61,13,29" 76 -- [Left (42,13),Right [61,13,29]] 77 -- >>> parse exampleInput 78 -- [Left (47,53),Left (97,13),Left (97,61),Left (97,47),Left (75,29),Left (61,13),Left (75,53),Left (29,13),Left (97,29),Left (53,29),Left (61,53),Left (97,53),Left (61,29),Left (47,13),Left (75,47),Left (97,75),Left (47,61),Left (75,61),Left (47,29),Left (75,13),Left (53,13),Right [75,47,61,53,29],Right [97,61,53,29,13],Right [75,29,13],Right [75,97,47,61,53],Right [61,13,29],Right [97,13,75,29,47]] 79 parse :: String -> [Either Rule Update] 80 parse s = catMaybes $ map helper $ lines s 81 where 82 helper :: String -> Maybe (Either Rule Update) 83 helper l = case (contains '|' l, contains ',' l) of 84 (True, False) -> liftM Left $ safeTuple $ sequence $ map (safeRead @Integer) $ words $ replace '|' ' ' l 85 (False, True) -> liftM Right $ sequence $ map (safeRead @Integer) $ words $ replace ',' ' ' l 86 _ -> Nothing 87 88 -- | Split the parsed puzzle for easier use 89 -- Example: 90 -- >>> (\(x,y) -> (reverse x, reverse y)) $ splitParsed $ parse exampleInput 91 -- ([(47,53),(97,13),(97,61),(97,47),(75,29),(61,13),(75,53),(29,13),(97,29),(53,29),(61,53),(97,53),(61,29),(47,13),(75,47),(97,75),(47,61),(75,61),(47,29),(75,13),(53,13)],[[75,47,61,53,29],[97,61,53,29,13],[75,29,13],[75,97,47,61,53],[61,13,29],[97,13,75,29,47]]) 92 splitParsed :: [Either Rule Update] -> ([Rule], [Update]) 93 splitParsed = helper [] [] 94 where 95 helper :: [Rule] -> [Update] -> [Either Rule Update] -> ([Rule], [Update]) 96 helper accL accR (x : xs) = case x of 97 Left p -> helper (p:accL) accR xs 98 Right l -> helper accL (l:accR) xs 99 helper accL accR [] = (accL, accR) 100 101 -- | Check if an update takes the rules into account as according to part 1 102 -- Example: 103 -- >>> let (rules, updates) = splitParsed $ parse exampleInput in reverse $ map (updateFollowsOrdering rules) updates 104 -- [True,True,True,False,False,False] 105 updateFollowsOrdering :: [Rule] -> Update -> Bool 106 updateFollowsOrdering = helper [] 107 where 108 helper :: Update -> [Rule] -> Update -> Bool 109 helper prev rules (x:xs) = obeysRules prev rules x 110 && helper (x:prev) rules xs 111 helper _ _ [] = True 112 obeysRules :: Update -> [Rule] -> Integer -> Bool 113 obeysRules prev rules x = all (obeysRule prev x) rules 114 obeysRule :: Update -> Integer -> Rule -> Bool 115 obeysRule (prev:prevs) x (a, b) 116 | x == b = True 117 | prev == b && x == a = False 118 | otherwise = obeysRule prevs x (a, b) 119 obeysRule [] _ _ = True 120 121 -- | Get the middle element of a list 122 -- Example: 123 -- >>> middleNumber [75,47,61,53,29] 124 -- 61 125 -- >>> middleNumber [97,61,53,29,13] 126 -- 53 127 -- >>> middleNumber [75,29,13] 128 -- 29 129 -- >>> middleNumber [75,97,47,61,53] 130 -- 47 131 -- >>> middleNumber [61,13,29] 132 -- 13 133 -- >>> middleNumber [97,13,75,29,47] 134 -- 75 135 middleNumber :: [a] -> a 136 middleNumber = helper [] 0 137 where 138 helper :: [a] -> Integer -> [a] -> a 139 helper acc t (x:xs) = helper (x:acc) (t+1) xs 140 helper acc t _ = acc !! (integerToInt t `div` 2) 141 142 -- | Solution to day 5 part 1 143 -- Example 144 -- >>> solution1 exampleInput 145 -- 143 146 solution1 :: String -> Integer 147 solution1 s = sum middles 148 where 149 (rules, updates) = splitParsed $ parse s 150 filtUps = filter (updateFollowsOrdering rules) updates 151 middles = map middleNumber filtUps 152 153 {- 154 -- Someone else's solution, they use an intmap, where the key is the LHS, and 155 -- the value is the RHS. 156 -- I was having a lot of trouble getting this part right, so I ended up giving 157 -- up. 158 -- Thanks to Quasido! 159 -- https://gitlab.com/Quasido/advent-of-code-2024/-/blob/master/05/Main.hs 160 ordPages :: RuleMap -> Int -> Int -> Ordering 161 ordPages rm left right = case elem right subs of 162 True -> GT 163 _ -> EQ 164 where subs = M.findWithDefault [] left rm 165 -} 166 167 ruleSort :: [Rule] -> Integer -> Integer -> Ordering 168 ruleSort ((a,b):rs) x y 169 | a == x && b == y = GT 170 | a == x && y `elem` subs = GT 171 | otherwise = ruleSort rs x y 172 where subs = map snd $ filter (\(l,_) -> l == x) rs 173 ruleSort [] _ _ = EQ 174 175 -- | Given an incorrect update, find a correct update of the same integers 176 -- Example: 177 -- >>> let (rules, _) = splitParsed $ parse exampleInput in findCorrectOrder rules [75,97,47,61,53] 178 -- [97,75,47,61,53] 179 -- >>> let (rules, _) = splitParsed $ parse exampleInput in findCorrectOrder rules [61,13,29] 180 -- [61,29,13] 181 -- >>> let (rules, _) = splitParsed $ parse exampleInput in findCorrectOrder rules [97,13,75,29,47] 182 -- [97,75,47,29,13] 183 -- >>> let (rules, parsed) = splitParsed $ parse exampleInput in all (updateFollowsOrdering rules) $ map (findCorrectOrder rules) parsed 184 -- True 185 findCorrectOrder :: [Rule] -> Update -> Update 186 findCorrectOrder rules = reverse . sortBy (ruleSort rules) 187 188 -- | Solution to day 5 part 2 189 -- Example: 190 -- >>> solution2 exampleInput 191 -- 123 192 solution2 :: String -> Integer 193 solution2 s = sum $ map middleNumber fixedUps 194 where 195 (rules, updates) = splitParsed $ parse s 196 incorrectUps = filter (not . updateFollowsOrdering rules) updates 197 fixedUps = map (findCorrectOrder rules) incorrectUps 198 199 solution :: IO (SolType, SolType) 200 solution = do 201 probStr <- input 202 let sol1 = solution1 probStr 203 let sol2 = solution2 probStr 204 return (IntSol sol1, IntSol sol2)