From f7bb5b70c52d92484ebb0d4998693f50b2d81c88 Mon Sep 17 00:00:00 2001 From: Felix Albrigtsen Date: Sun, 4 Dec 2022 16:25:44 +0100 Subject: [PATCH] Uploaded new day04 with friendly improvements --- day04/main_improved.hs | 54 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 day04/main_improved.hs diff --git a/day04/main_improved.hs b/day04/main_improved.hs new file mode 100644 index 0000000..90db626 --- /dev/null +++ b/day04/main_improved.hs @@ -0,0 +1,54 @@ + -- main.hs as written by me, thuroughly fixed by +main :: IO () +main = do + file <- readFile "input.txt" + let + pairs :: [((Int, Int), (Int, Int))] + pairs = inputLinesToPairs file + + putStrLn "Part 1: " + print $ part1 pairs + + putStrLn "Part 2: " + print $ part2 pairs + +-- Map each line of input from "1-2,3-4" to ((1,2),(3,4)) +inputLinesToPairs :: String -> [((Int, Int), (Int, Int))] +inputLinesToPairs input = result + where + stringpairs :: [[String]] + stringpairs = map (splitWhen (==',')) $ lines input + + parseRange :: String -> (Int, Int) + parseRange pair = (read first, read second) + where + (first:second:_) = splitWhen (=='-') pair + + result :: [((Int, Int), (Int, Int))] + result = map (\x -> (head x, last x)) $ map (map parseRange) stringpairs + + +part1 :: [((Int, Int), (Int, Int))] -> Int +part1 = length . filter (uncurry rangeIsContained) + +part2 :: [((Int, Int), (Int, Int))] -> Int +part2 = length . filter (uncurry rangeOverlaps) + +-- True if any part of the two ranges overlap +rangeOverlaps :: (Int, Int) -> (Int, Int) -> Bool +rangeOverlaps (lo1, hi1) (lo2, hi2) = rangeIsContained (lo1, lo1) (lo2, hi2) + || (lo2 >= lo1 && lo2 <= hi1) + || (hi2 >= lo1 && hi2 <= hi1) + +-- True if the first range is entirely contained in the second range, or vice versa +rangeIsContained :: (Int, Int) -> (Int, Int) -> Bool +rangeIsContained (lo1, hi1) (lo2, hi2) = (lo1 <= lo2 && hi1 >= hi2) + || (lo1 >= lo2 && hi1 <= hi2) + +-- Modified from Prelude.words +splitWhen :: (Char -> Bool) -> String -> [String] +splitWhen p s = case dropWhile p s of + "" -> [] + s' -> w : splitWhen p s'' + where (w, s'') = break p s' +