Done part 2, needs tidying

diff --git a/advent05/Main.hs b/advent05/Main.hs
index 7934a78cb0bb81019963bfc0908a994acef805f1..7f0aefa23f499336b49afe1bf23f4ef1b095b4a6 100644 (file)
--- a/advent05/Main.hs
+++ b/advent05/Main.hs
@@ -5,7 +5,7 @@ import Data.Text (Text)
 import qualified Data.Text.IO as TIO
 import Data.Attoparsec.Text -- hiding (take)
 import Control.Applicative
--- import Data.List
+import Data.List
 import qualified Data.Map.Strict as M
 import Data.Map.Strict ((!))
 import Data.Maybe
@@ -13,8 +13,10 @@ import Data.List.Split (chunksOf)
 
 type Almanac = M.Map String AMap
 data AMap = AMap String [Rule] deriving (Eq, Show)
-data Rule = Rule Int Int Int deriving (Eq, Show)
-data Requirement = Requirement String [Int] deriving (Eq, Show)
+data Rule = Rule Interval Int deriving (Eq, Ord, Show)
+data Requirement = Requirement String [Interval] deriving (Eq, Show)
+
+data Interval = Iv Int Int deriving (Eq, Ord, Show) -- inclusive, closed at both ends
 
 
 main :: IO ()
@@ -22,23 +24,36 @@ 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
-      -- print $ expandRanges 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 :: Almanac -> [Int] -> Int
+-- part1 = lowestLocation
+
+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
 
-part2 almanac seeds = lowestLocation almanac $ expandRanges seeds
 
-lowestLocation almanac seeds = minimum locations
+lowestLocation almanac seeds = l
   where Requirement _ locations = followRequirements almanac $ Requirement "seed" seeds
+        (Iv l h) = head locations
 
 followRequirements :: Almanac -> Requirement -> Requirement
 followRequirements almanac req@(Requirement "location" vals) = req
@@ -49,25 +64,70 @@ followRequirements almanac (Requirement name vals) =
 
 
 
-useRule :: Int -> Rule -> Maybe Int
-useRule x (Rule dest src rl)
-  | x >= src && x < (src + rl) = Just (x + dest - src)
-  | otherwise = Nothing
+-- 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)
+  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
+
+
+useRules :: [Rule] -> [Interval] -> [Interval]
+useRules [] ivs = ivs
+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
+
+
+legalInterval :: Interval -> Bool
+legalInterval (Iv l h) = l <= h
 
-useRules :: [Rule] -> Int -> Int
-useRules rs x 
-  | null ruleResults = x
-  | otherwise = head ruleResults
-  where ruleResults = catMaybes $ fmap (useRule x) rs
+legalRule (Rule iv _) = legalInterval iv
 
-useAMap :: AMap -> [Int] -> Requirement
-useAMap (AMap d rs) xs = Requirement d $ fmap (useRules rs) xs
+useAMap :: AMap -> [Interval] -> Requirement
+useAMap (AMap d rs) xs = Requirement d $ tidyIntervals $ useRules rs xs
 
 
-expandRanges :: [Int] -> [Int]
-expandRanges seeds = concatMap expandRange ranges
+singletonRanges :: [Int] -> [Interval]
+singletonRanges = fmap (\x -> Iv x x)
+
+expandRanges :: [Int] -> [Interval]
+expandRanges seeds = fmap expandRange ranges
   where ranges = chunksOf 2 seeds
-        expandRange [s, l] = [s..(s + l - 1)]
+        expandRange [s, l] = Iv s (s + l - 1)
+
+
+tidyIntervals :: [Interval] -> [Interval]
+tidyIntervals ivs0 = tidyIntervalsS $ sort ivs0
+
+tidyIntervalsS :: [Interval] -> [Interval]
+tidyIntervalsS [] = []
+tidyIntervalsS [x] = [x]
+tidyIntervalsS (x:y:xs)
+  | x `allBelow` y = x : tidyIntervalsS (y:xs)
+  | otherwise = tidyIntervalsS $ (x `merge` y) : xs
+
+allBelow :: Interval -> Interval -> Bool
+allBelow (Iv x1 x2) (Iv y1 y2) = (x2 + 1) < y1 
+
+merge :: Interval -> Interval -> Interval
+merge (Iv x1 x2) (Iv y1 y2) = Iv (min x1 y1) (max x2 y2)
+
 
 
 -- Parse the input file
@@ -94,7 +154,7 @@ aMapP = aMapify <$> aMapHeaderP <*> rulesP
 aMapHeaderP = (,) <$> (nameP <* "-to-") <*> (nameP <* " map:" <* endOfLine)
 
 rulesP = ruleP `sepBy` endOfLine
-ruleP = Rule <$> (decimal <* space) <*> (decimal <* space) <*> decimal
+ruleP = ruleify <$> (decimal <* space) <*> (decimal <* space) <*> decimal
 
 numbersP = decimal `sepBy` skipSpace
 nameP = many1 letter
@@ -102,7 +162,10 @@ nameP = many1 letter
 blankLineP = endOfLine *> endOfLine
 
 aMapify :: (String, String) -> [Rule] -> (String, AMap)
-aMapify (s, d) rs = (s, AMap d rs)
+aMapify (s, d) rs = (s, AMap d (sort rs))
+
+ruleify :: Int -> Int -> Int -> Rule
+ruleify d s l = Rule (Iv s (s + l - 1)) (d - s)
 
 successfulParse :: Text -> ([Int], Almanac)
 successfulParse input =