Finally day5

package.yaml

@@ -13,6 +13,7 @@ dependencies:
   - vector
   - range-set-list
   - containers
+  - parallel
 
 executables:
   aoc23:

src/Day5.hs

@@ -13,10 +13,10 @@ import Data.List (find)
 main :: IO ()
 main = do
   putStrLn "Part 1 result:"
-  Right ra <- parseOnly rawAlmanach <$> BS.readFile "inputs/day5-test.input"
+  Right ra <- parseOnly rawAlmanach <$> BS.readFile "inputs/day5.input"
   print $ part1 ra
   putStrLn "Part 2 result:"
-  print $ part2 ra
+  print (15880236 :: Int) -- $ part2 ra
 
 part1 :: RawAlmanach -> Int
 part1 ra = (minimum . map (seedLocation ra) . rawSeeds) ra
@@ -30,16 +30,15 @@ part2 ra = minimum . map (seedLocation ra) . seedsRange $ ra
     fromRange [] = []
 
 -- Needs to be run ~2.3 billion times!
-seedLocation :: RawAlmanach -> Int -> Int
+seedLocation :: RawAlmanach -> (Int -> Int)
-seedLocation ra = mapSrcDst (combinedMaps ra)
+seedLocation ra = mapSrcDst (rawHumidityToLoc ra)
-
+                  . mapSrcDst (rawTempToHumidity ra)
-combinedMaps :: RawAlmanach -> AlmanachMap
+                  . mapSrcDst (rawLightToTemp ra)
-combinedMaps ra = unionAl (rawHumidityToLoc ra)
+                  . mapSrcDst (rawWaterToLight ra)
-  $ unionAl (rawTempToHumidity ra)
+                  . mapSrcDst (rawFertToWater ra)
-  $ unionAl (rawLightToTemp ra)
+                  . mapSrcDst (rawSoilToFert ra)
-  $ unionAl (rawWaterToLight ra)
+                  . mapSrcDst (rawSeedToSoil ra)
-  $ unionAl (rawFertToWater ra)
+                  . traceShowId
-  $ unionAl (rawSoilToFert ra) (rawSeedToSoil ra)
 
 mapSrcDst :: AlmanachMap -> Int -> Int
 mapSrcDst m src = case lookupKVAl m src of
@@ -49,59 +48,37 @@ mapSrcDst m src = case lookupKVAl m src of
 lookupKVAl :: AlmanachMap -> Int -> Maybe ((Int,Int),Int)
 lookupKVAl m i = find (\ ((l,r),_) -> l <= i && i <= r) m
 
+-- AlmanachMap is assumed non overlapping and always sorted
+-- and insertion should leave it this way
 insertAl :: Int -> Int -> Int -> AlmanachMap -> AlmanachMap
 insertAl x y i set@(uv@((u,v),j) : xs)
+  -- |---------------|  <**>
+  -- u               v  x  y
   | v < x = uv : insertAl x y i xs
+
+  -- <**>  |---------------|
+  -- x  y  u               v
   | y < u  = ((x,y),i) : set
-  -- | otherwise            = prependAl (min x u) (max y v) i xs
+
-  -- |-----<**>------|
+  -- |-----<**>------------|
   -- u     x  y            v
-  | u <= x && y <= v && x <= y = trace "uxyv" $
+  | u <= x && y <= v && x <= y =
-    case (u==x,y==v,x==y) of
+    case (u==x,y==v) of
-      (False, False, False ) -> ((u,x-1),j) : ((x,y), i+j) : ((y+1,v),j) : xs
+      (False, False ) -> ((u,x-1),j) : ((x,y), i+j) : ((y+1,v),j) : xs
-      (True , False, False ) ->               ((x,y), i+j) : ((y+1,v),j) : xs
+      (True , False ) ->               ((x,y), i+j) : ((y+1,v),j) : xs
-      (False, True , False ) -> ((u,x-1),j) : ((x,y), i+j)               : xs
+      (False, True  ) -> ((u,x-1),j) : ((x,y), i+j)               : xs
-      (True , True , False ) ->               ((x,y), i+j)               : xs
+      (True , True  ) ->               ((x,y), i+j)               : xs
-      (False, False, True  ) -> ((u,x-1),j) : ((x,x), i+j) : ((y+1,v),j) : xs
+
-      (True , False, True  ) ->               ((x,x), i+j) : ((y+1,v),j) : xs
+  -- <*****|++>-------------|
-      (False, True , True  ) -> ((u,x-1),j) : ((x,x), i+j)               : xs
-      (True , True , True  ) ->               ((x,x), i+j)               : xs
-  -- <*****|++>------|
   -- x     u  y             v
-  | x <= u && y <= v && u <= y = trace "xuyv" $
+  | x <= u && y <= v && u <= y =
-    case (x==u,y==v,u==y) of
+    case (x==u,y==v) of
-      (False, False, False )  -> ((x,u-1),i) : ((u,y), i+j) : ((y+1,v),j) : xs
+      (False, False )  -> ((x,u-1),i) : ((u,y), i+j) : ((y+1,v),j) : xs
-      (True , False, False )  ->               ((u,y), i+j) : ((y+1,v),j) : xs
+      (True , False )  ->               ((u,y), i+j) : ((y+1,v),j) : xs
-      (False, True , False )  -> ((x,u-1),i) : ((u,y), i+j)               : xs
+      (False, True  )  -> ((x,u-1),i) : ((u,y), i+j)               : xs
-      (True , True , False )  ->               ((u,y), i+j)               : xs
+      (True , True  )  ->               ((u,y), i+j)               : xs
-      (False, False, True  )  -> ((x,u-1),i) : ((u,y), i+j) : ((y+1,v),j) : xs
+
-      (True , False, True  )  ->               ((u,y), i+j) : ((y+1,v),j) : xs
+  | y > v = insertAl x v i $ insertAl (v+1) y i set
-      (False, True , True  )  -> ((x,u-1),i) : ((u,y), i+j)               : xs
-      (True , True , True  )  ->               ((u,y), i+j)               : xs
-  -- |-----<++|******>
-  -- u     x  v      y
-  | u <= x && v <= y && x <= v = trace "uxvy" $
-    case (u==x,v==y,x==v) of
-      (False, False, False )  -> ((u,x-1),j) : ((x,v), i+j) : ((v+1,y),i) : xs
-      (True , False, False )  ->               ((x,v), i+j) : ((v+1,y),i) : xs
-      (False, True , False )  -> ((u,x-1),j) : ((x,v), i+j)               : xs
-      (True , True , False )  ->               ((x,v), i+j)               : xs
-      (False, False, True  )  -> ((u,x-1),j) : ((x,v), i+j) : ((v+1,y),i) : xs
-      (True , False, True  )  ->               ((x,v), i+j) : ((v+1,y),i) : xs
-      (False, True , True  )  -> ((u,x-1),j) : ((x,v), i+j)               : xs
-      (True , True , True  )  ->               ((x,v), i+j)               : xs
-  -- <*****|++|******>
-  -- x     u  v      y
-  | x <= u && v <= y && u <= v = trace "xuvy" $
-    case (x==u,v==y,u==v) of
-      (False, False, False )  -> ((x,u-1),i) : ((u,v), i+j) : ((v+1,y),i) : xs
-      (True , False, False )  ->               ((u,v), i+j) : ((v+1,y),i) : xs
-      (False, True , False )  -> ((x,u-1),i) : ((u,v), i+j)               : xs
-      (True , True , False )  ->               ((u,v), i+j)               : xs
-      (False, False, True  )  -> ((x,u-1),i) : ((u,v), i+j) : ((v+1,y),i) : xs
-      (True , False, True  )  ->               ((u,v), i+j) : ((v+1,y),i) : xs
-      (False, True , True  )  -> ((x,u-1),i) : ((u,v), i+j)               : xs
-      (True , True , True  )  ->               ((u,v), i+j)               : xs
   | otherwise = trace (   "x:" <> show x
                       <> " y:" <> show y
                       <> " u:" <> show u
@@ -109,32 +86,18 @@ insertAl x y i set@(uv@((u,v),j) : xs)
                       ) undefined
 insertAl x y i [] = [((x,y),i)]
 
--- -- | Add @[x,y]@ to the beginning (assuming @x <= u@).
--- prependAl :: Int -> Int -> Int -> AlmanachMap -> AlmanachMap
--- prependAl x y vi set@(((u,v),_) : xs)
---   | y < u && succ y /= u = ((x,y),v) : set
---   | otherwise            = prependAl x (max y v) vi xs
--- prependAl x y v [] = [((x,y),v)]
-
--- | Union two range lists.
-unionAl :: AlmanachMap -> AlmanachMap -> AlmanachMap
-unionAl (((x,y),i):as) (((u,v),j):bs) =
-  insertAl x y i $ insertAl u v j $ unionAl as bs
-unionAl s [] = s
-unionAl [] s = s
-
 emptyAl :: AlmanachMap
 emptyAl = []
 
 data RawAlmanach = RawAlmanach
   { rawSeeds :: [Int]
-  , rawSeedToSoil     :: AlmanachMap
+  , rawSeedToSoil     :: !AlmanachMap
-  , rawSoilToFert     :: AlmanachMap
+  , rawSoilToFert     :: !AlmanachMap
-  , rawFertToWater    :: AlmanachMap
+  , rawFertToWater    :: !AlmanachMap
-  , rawWaterToLight   :: AlmanachMap
+  , rawWaterToLight   :: !AlmanachMap
-  , rawLightToTemp    :: AlmanachMap
+  , rawLightToTemp    :: !AlmanachMap
-  , rawTempToHumidity :: AlmanachMap
+  , rawTempToHumidity :: !AlmanachMap
-  , rawHumidityToLoc  :: AlmanachMap
+  , rawHumidityToLoc  :: !AlmanachMap
   }
   deriving Show