2 files changed, 54 insertions(+), 5 deletions(-)

M 2023/10.hs
A 2023/10b.example

@@ 122,19 122,59 @@ findLoop (start, pipes) =
   (:) start $ walk e [] a b
   where cs = connections pipes
         cs' = connections' pipes
-        walk e !acc p q | q == e = e:acc
+        walk e !acc p q | q == e = e:p:acc
         walk e !acc p q | otherwise = walk e (p:acc) q (next p q)
         next p q = let n:[] = List.delete p $ cs' q in n
 
 partA :: Parse -> Int
-partA = succ . (flip div 2) . length . findLoop
+partA = (flip div 2) . length . findLoop
+
+
+-- partB TODO: double the space creating tiles "between" the current tiles
 
 --partB :: Parse -> Parse
---partB = id
+partB p = let (r, ps) = f st0 (coords bb) in putStrLn (draw ps)
+  where loop = findLoop p
+        bb = boundingBox loop
+        coords ((xm, ym), (xM, yM)) = [(x,y) | x<-[xm..xM], y<-[ym..yM]]
+
+        draw ps =
+          let ((xm, ym), (xM, yM)) = bb 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 -> 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
+          in ((pred xm, pred ym), (succ xM, succ yM))
+        ns (x,y) = [(x-1,y),(x+1,y),(x,y-1),(x,y+1)]
+
+        inBox ((xm, ym), (xM, yM)) (x, y) = (x >= xm) && (x <= xM) && (y >= ym) && (y <= yM)
+
+        st0 = (0, Map.fromList $ fmap (\p -> (p, 0)) loop)
+
+        f st [] = st
+        f st@(r, ps) (q:qs) =
+          let st' = if Map.member q ps then st else g (succ r, ps, Set.empty) [q]
+          in f st' qs
+
+        g (r, ps, _) [] = (r, ps)
+        g st@(r, ps, vs) (q:qs) =
+          if Set.member q vs then g st qs else
+          if Map.member q ps then g st qs else
+          let ps' = Map.alter (h r) q ps in
+          let vs' = Set.insert q vs in
+          let qs' = (filter (inBox bb) $ ns q) ++ qs in
+          g (r, ps', vs') qs'
+
+        h _ (Just r') = undefined
+        h r Nothing = Just r
 
 main :: IO ()
 main = with parser $ do
   run "10.example" "a example" partA -- 8
   run "10.input" "a input" partA -- 6838
-  --run "10.example" "b example" partB
-  --run "10.input" "b input" partB
+  runIO "10b.example" "b example" partB
+  --runIO "10.input" "b input" partB

@@ 0,0 1,9 @@
+..........
+.S------7.
+.|F----7|.
+.||....||.
+.||....||.
+.|L-7F-J|.
+.|..||..|.
+.L--JL--J.
+..........