Tidying

[advent-of-code-23.git] / advent05 / Main.hs

diff --git a/advent05/Main.hs b/advent05/Main.hs
index 7f0aefa23f499336b49afe1bf23f4ef1b095b4a6..d8bb80651619e20b6408db47ece5cfb9e999f897 100644 (file)
--- a/advent05/Main.hs
+++ b/advent05/Main.hs
@@ -1,14 +1,13 @@
--- Writeup at https://work.njae.me.uk/2023/12/04/advent-of-code-2023-day-04/
+-- Writeup at https://work.njae.me.uk/2023/12/05/advent-of-code-2023-day-05/
 
 import AoC
 import Data.Text (Text)
 import qualified Data.Text.IO as TIO
 import Data.Attoparsec.Text -- hiding (take)
-import Control.Applicative
+-- import Control.Applicative
 import Data.List
 import qualified Data.Map.Strict as M
 import Data.Map.Strict ((!))
-import Data.Maybe
 import Data.List.Split (chunksOf)
 
 type Almanac = M.Map String AMap
@@ -24,79 +23,54 @@ main =
   do  dataFileName <- getDataFileName
       text <- TIO.readFile dataFileName
       let (seeds, almanac) = successfulParse text
-      let eSeeds = tidyIntervals $ expandRanges seeds
-      -- print seeds
-      -- print eSeeds
-      -- print almanac
-      -- print $ useAMap (almanac ! "seed") [97, 98, 99, 100]
-      -- print $ useAMap (almanac ! "seed") [49, 50, 51, 53, 96, 97, 98]
-      -- print $ useAMap (almanac ! "seed") [79, 14, 55, 13]
       print $ part1 almanac seeds
-      -- let seedRanges = tidyIntervals eSeeds
-      -- print $ useAMap (almanac ! "seed") seedRanges
-      -- print $ useAMap (almanac ! "seed") [Iv 0 55]
-      -- print $ useAMap (almanac ! "seed") [Iv 95 105]
-      -- print $ part2 almanac [(Iv 82 82)]
       print $ part2 almanac seeds
-      -- print $ part2 cards
-
--- part1 :: Almanac -> [Int] -> Int
--- part1 = lowestLocation
-
+      
+part1, part2 :: Almanac -> [Int] -> Int
 part1 almanac seeds = lowestLocation almanac seeds'
   where seeds' = tidyIntervals $ singletonRanges seeds
 
 part2 almanac seeds = lowestLocation almanac seeds'
   where seeds' = tidyIntervals $ expandRanges seeds
--- part2 almanac seeds = followRequirements almanac $ Requirement "seed" seeds
-
 
+lowestLocation :: Almanac -> [Interval] -> Int
 lowestLocation almanac seeds = l
   where Requirement _ locations = followRequirements almanac $ Requirement "seed" seeds
-        (Iv l h) = head locations
+        (Iv l _) = head locations
 
 followRequirements :: Almanac -> Requirement -> Requirement
-followRequirements almanac req@(Requirement "location" vals) = req
+followRequirements _ req@(Requirement "location" _) = req
 followRequirements almanac (Requirement name vals) = 
   followRequirements almanac newReq
   where aMap = almanac ! name
         newReq = useAMap aMap vals
 
 
-
--- useRule :: Interval -> Rule -> [Interval]
--- useRule (Iv xl xh) (Rule (Iv rl rh) d)
---   | x >= src && x < (src + rl) = Just (x + dest - src)
---   | otherwise = Nothing
-
--- useRules :: [Rule] -> Int -> Int
--- useRules rs x 
---   | null ruleResults = x
---   | otherwise = head ruleResults
---   where ruleResults = catMaybes $ fmap (useRule x) rs
-
 useRule :: Rule -> Interval -> ([Interval], [Interval], [Rule])
-useRule (Rule (Iv rl rh) d) (Iv xl xh) = (newResults, newIvs, newRules)
+useRule (Rule (Iv rl rh) d) (Iv xl xh) = (newResults, newVals, newRules)
   where newResults = 
-          filter legalInterval [ Iv (min xl rl) (min xh (rl - 1)) -- input below rule
-                               , Iv ((max xl rl) + d) ((min xh rh) + d)] -- input within rule
-        newIvs = filter legalInterval [Iv (max xl (rh + 1)) (max xh rh)] -- input above rule
-        newRules = filter legalRule [Rule (Iv (max (xh + 1) rl) (max xh rh)) d] -- rule above input
+           filter legalInterval 
+            [ Iv xl (rl - 1) -- input below rule
+            , Iv ((max xl rl) + d) ((min xh rh) + d)] -- input within rule
+        newVals = filter legalInterval 
+            [Iv (rh + 1) xh] -- input above rule
+        newRules = filter legalRule 
+            [Rule (Iv (xh + 1) rh) d] -- rule above input
 
 
 useRules :: [Rule] -> [Interval] -> [Interval]
-useRules [] ivs = ivs
+useRules [] vals = vals
 useRules _ [] = []
-useRules (r@(Rule (Iv rl rh) d):rs) (iv@(Iv xl xh):ivs)  
-  | rh < xl = useRules rs (iv:ivs)
-  | xh < rl = iv : useRules (r:rs) ivs
-  | otherwise = newResults ++ (useRules (newRules ++ rs) (newIvs ++ ivs))
-  where (newResults, newIvs, newRules) = useRule r iv
-
+useRules (r@(Rule rv _):rs) (v:vs)  
+  | rv `allBelow` v = useRules rs (v:vs)
+  | v `allBelow` rv = v : useRules (r:rs) vs
+  | otherwise = newResults ++ (useRules (newRules ++ rs) (newVals ++ vs))
+  where (newResults, newVals, newRules) = useRule r v
 
 legalInterval :: Interval -> Bool
 legalInterval (Iv l h) = l <= h
 
+legalRule :: Rule -> Bool
 legalRule (Rule iv _) = legalInterval iv
 
 useAMap :: AMap -> [Interval] -> Requirement
@@ -113,17 +87,17 @@ expandRanges seeds = fmap expandRange ranges
 
 
 tidyIntervals :: [Interval] -> [Interval]
-tidyIntervals ivs0 = tidyIntervalsS $ sort ivs0
+tidyIntervals = tidyIntervalsS . sort
 
 tidyIntervalsS :: [Interval] -> [Interval]
 tidyIntervalsS [] = []
 tidyIntervalsS [x] = [x]
 tidyIntervalsS (x:y:xs)
   | x `allBelow` y = x : tidyIntervalsS (y:xs)
-  | otherwise = tidyIntervalsS $ (x `merge` y) : xs
+  | otherwise = tidyIntervalsS ((x `merge` y) : xs)
 
 allBelow :: Interval -> Interval -> Bool
-allBelow (Iv x1 x2) (Iv y1 y2) = (x2 + 1) < y1 
+allBelow (Iv _ x2) (Iv y1 _) = (x2 + 1) < y1 
 
 merge :: Interval -> Interval -> Interval
 merge (Iv x1 x2) (Iv y1 y2) = Iv (min x1 y1) (max x2 y2)