1 files changed, 36 insertions(+), 9 deletions(-)

M 2023/10.hs

@@ 130,12 130,16 @@ partA :: Parse -> Int
 partA = (flip div 2) . length . findLoop
 
 
--- partB TODO: double the space creating tiles "between" the current tiles
-
---partB :: Parse -> Parse
-partB p = let (r, ps) = f st0 (coords bb) in putStrLn (draw ps)
-  where loop = findLoop p
-        bb = boundingBox loop
+doubleTheLoop (start@(x0,y0):ps) = g [] start ps
+  where g acc (x,y) [] =
+          let i = (2*x + x0-x, 2*y + y0-y) in
+          i:(2*x,2*y):acc
+        g acc p@(x,y) (q@(x',y'):ps) =
+          let i = (2*x + x'-x, 2*y + y'-y) in
+          g (i:(2*x,2*y):acc) q ps
+
+regionFinderOuter loop = snd $ f st0 (coords bb)
+  where bb = boundingBox loop
         coords ((xm, ym), (xM, yM)) = [(x,y) | x<-[xm..xM], y<-[ym..yM]]
 
         draw ps =


@@ 144,7 148,7 @@ partB p = let (r, ps) = f st0 (coords bb) in putStrLn (draw ps)
             foldl' (++) "" $ flip fmap [xm..xM] $ \x ->
               case Map.lookup (x,y) ps of
                 Nothing -> "."
-                Just r -> show r
+                Just r -> [ last $ show r ]
 
         boundingBox (p:ps) =
           let ((xm, ym), (xM, yM)) = foldl' (\((xm, ym), (xM, yM)) (x, y) -> ((min xm x, min ym y), (max xM x, max yM y))) (p,p) ps


@@ 172,9 176,32 @@ partB p = let (r, ps) = f st0 (coords bb) in putStrLn (draw ps)
         h _ (Just r') = undefined
         h r Nothing = Just r
 
+partB :: Parse -> Int
+partB p = length . filter (>1) $ Map.elems withFixedLeaks
+  where loop = findLoop p
+        rs = regionFinderOuter loop
+        rs' = regionFinderOuter $ doubleTheLoop loop
+
+        withFixedLeaks = Map.foldlWithKey' fixLeaks Map.empty rs
+        fixLeaks qs p@(x,y) r =
+          case Map.lookup (2*x,2*y) rs' of
+            Nothing -> Map.insert p r qs
+            Just r' -> Map.insert p (if r' == 1 then 1 else r) qs
+
+        draw ps =
+          let ((xm, ym), (xM, yM)) = boundingBox $ Map.keys ps in
+          foldl' (\acc l -> acc ++ l ++ "\n") "" $ flip fmap [ym..yM] $ \y ->
+            foldl' (++) "" $ flip fmap [xm..xM] $ \x ->
+              case Map.lookup (x,y) ps of
+                Nothing -> "."
+                Just r -> [ last $ show r ]
+
+        boundingBox (p:ps) =
+          foldl' (\((xm, ym), (xM, yM)) (x, y) -> ((min xm x, min ym y), (max xM x, max yM y))) (p,p) ps
+
 main :: IO ()
 main = with parser $ do
   run "10.example" "a example" partA -- 8
   run "10.input" "a input" partA -- 6838
-  runIO "10b.example" "b example" partB
-  --runIO "10.input" "b input" partB
+  run "10b.example" "b example" partB -- 4
+  run "10.input" "b input" partB -- 451