Further day 22 optimizations I apparently forgot about (??)

Author: Demindiro

2021/22/Main.hs

@@ -8,9 +8,9 @@ import qualified Data.IntMap.Strict  as M
 type Point = (Int, Int, Int)
 -- Areas are half-open!
 type Area  = (Point, Point)
-type Step  = (Bool, Area)
+type Grid  = A.UArray Point Bool
 
-parse :: String -> Step
+parse :: String -> (Bool, Area)
 parse s | ('o':'n':' ':s')     <- s = (True , f s')
         | ('o':'f':'f':' ':s') <- s = (False, f s')
   where
@@ -27,34 +27,35 @@ intersection (a, b) (l, h) = (f max a l, f min b h)
 
 valid ((lx,ly,lz),(hx,hy,hz)) = lx < hx && ly < hy && lz < hz
 
-main = do
-  steps <- map parse <$> lines <$> readFile "input.txt"
-  let steps' = filter (valid . snd) $ map bounds steps
-  let (x',y',z') = unzip3 $ foldMap (\(_,(a,b)) -> [a,b]) steps
-  let [x, y, z ] = map nubSort [x', y', z']
-  let ![ax,ay,az] = let f l = A.listArray (0, length l - 1) l
-                        f :: [Int] -> A.UArray Int Int
-                    in  [f x, f y, f z]
-  let ![mx,my,mz] = map M.fromList [zip x [0..], zip y [0..], zip z [0..]]
-  let grid = A.listArray ((0,0,0),(length x,length y,length z)) $ repeat False
-      grid :: A.UArray Point Bool
-  let step g (o,((lx,ly,lz),(hx,hy,hz))) = g'
-        where [sx, sy, sz] =          [mx M.! lx, my M.! ly, mz M.! lz]
-              [ex, ey, ez] = map pred [mx M.! hx, my M.! hy, mz M.! hz]
-              l  = [((x,y,z),o) | x <- [sx..ex], y <- [sy..ey], z <- [sz..ez]]
-              g' = A.accum seq g l :: A.UArray Point Bool
-  let size (ix,iy,iz) = product [ex - sx, ey - sy, ez - sz]
-        where [sx, sy, sz] = [ax A.!      ix, ay A.!      iy, az A.!      iz]
-              [ex, ey, ez] = [ax A.! succ ix, ay A.! succ iy, az A.! succ iz]
-  -- This long version reduces runtime from ~58 sec to ~12
-  -- A.assocs is very slow :(
-  let count :: A.UArray Point Bool -> Int
-      count g = sum [ size (x,y,z)
-                    | x <- [0..length x-1]
-                    , y <- [0..length y-1]
-                    , z <- [0..length z-1]
-                    , g A.! (x,y,z)
-                    ]
-  mapM_ (print . count . foldl step grid) [steps', steps]
+solve steps = count $ foldl step grid steps
   where
-    bounds (o,a) = (o, intersection ((-50,-50,-50),(51,51,51)) a)
+    (x',y',z') = unzip3 $ foldMap (\(_,(a,b)) -> [a,b]) steps
+    [x, y, z ] = map nubSort [x', y', z']
+    [xl,yl,zl] = map length  [x , y , z ]
+    ![ax,ay,az] = let f l = A.listArray (0, length l - 1) l
+                      f :: [Int] -> A.UArray Int Int
+                  in  [f x, f y, f z]
+    ![mx,my,mz] = map M.fromList [zip x [0..], zip y [0..], zip z [0..]]
+    grid :: Grid
+    grid = A.listArray ((0,0,0),(xl-1,yl-1,zl-1)) $ repeat False
+    step g (o,((lx,ly,lz),(hx,hy,hz))) = g A.// l :: Grid
+      where [sx, sy, sz] =          [mx M.! lx, my M.! ly, mz M.! lz]
+            [ex, ey, ez] = map pred [mx M.! hx, my M.! hy, mz M.! hz]
+            l = [((x,y,z),o) | x <- [sx..ex], y <- [sy..ey], z <- [sz..ez]]
+    size (ix,iy,iz) = product [ex - sx, ey - sy, ez - sz]
+      where [sx, sy, sz] = [ax A.!      ix, ay A.!      iy, az A.!      iz]
+            [ex, ey, ez] = [ax A.! succ ix, ay A.! succ iy, az A.! succ iz]
+    -- This long version reduces runtime from ~58 sec to ~12
+    -- A.assocs is very slow :(
+    count :: Grid -> Int
+    count g = sum [ size (x,y,z)
+                  | x <- [0..xl - 1]
+                  , y <- [0..yl - 1]
+                  , z <- [0..zl - 1]
+                  , g A.! (x,y,z)
+                  ]
+
+main = map parse <$> lines <$> readFile "input.txt"
+   >>= \steps -> let steps' = filter (valid . snd) $ map bounds steps
+                 in  mapM_ (print . solve) [steps', steps]
+  where bounds (o,a) = (o, intersection ((-50,-50,-50),(51,51,51)) a)