From 4e1d02c73b1366617fc2d8d54b3a080f423c1538 Mon Sep 17 00:00:00 2001
From: tzlil <tzlils@protonmail.com>
Date: Sun, 21 Apr 2024 00:05:58 +0300
Subject: finished day10

---
 10/Main.hs | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 60 insertions(+)
 create mode 100644 10/Main.hs

(limited to '10/Main.hs')

diff --git a/10/Main.hs b/10/Main.hs
new file mode 100644
index 0000000..0988b6d
--- /dev/null
+++ b/10/Main.hs
@@ -0,0 +1,60 @@
+module Main where
+import Algebra.Graph
+import Data.List
+import Data.Bifunctor (first, second, bimap)
+import Data.Foldable (fold)
+import Data.Monoid
+import Data.Tree (drawForest, Tree(Node))
+import Algebra.Graph.ToGraph (dfsForestFrom, preSet)
+import Data.Set (toList)
+import Debug.Trace
+
+-- convert map to graph
+maze tiles = fold [f tile (x,y) | (y, row) <- enumerate tiles, (x, tile) <- enumerate row] where
+  enumerate = zip [0..]
+  pipe f g = (,First Nothing) . (Overlay.((Connect . Vertex) <*> Vertex . f) <*> (Connect . Vertex <*> Vertex . g))
+  f '.' = (,) . Vertex <*> (const (First Nothing))
+  f '|' = pipe (second (+1)) (second $ subtract 1)
+  f '-' = pipe (first (+1)) (first $ subtract 1)
+  f 'L' = pipe (second $ subtract 1) (first (+1))
+  f 'J' = pipe (second $ subtract 1) (first $ subtract 1)
+  f '7' = pipe (second (+1)) (first $ subtract 1)
+  f 'F' = pipe (second (+1)) (first (+1))
+  f 'S' = (Empty,) . First . Just
+
+mainloop :: [String] -> [(Int, Int)]
+mainloop tiles = circuit where
+  (g, First (Just s)) = maze tiles
+  -- connect start to the appropriate tiles
+  g' = overlay (connect (vertex s) $ vertices . toList $ preSet s g) g
+  [g''] = dfsForestFrom g' [s]
+  -- find all paths from root (there should be only one)
+  summarize (Node l ts) = if ts /= [] then [l:summary | t <- ts, summary <- summarize t] else [[l]]
+  [circuit] =  summarize g''
+
+part1 tiles = (length (mainloop tiles) - 1) `div` 2 + 1 where
+
+part2 tiles = length enclosed where
+  (g, First (Just s)) = maze tiles
+  circuit = mainloop tiles
+
+  -- even-odd rule
+  -- inside tile = (foldl (/=) False $ [isLeftOf tile pipe | pipe <- circuit]) && (foldl (/=) False $ [isRightOf tile pipe | pipe <- circuit])
+  both = bimap <*> id
+  pairwise = zip <*> tail
+  
+  -- offset the points on the circuit so we dont get subset lines 
+  offgrid = both ((+0.5).fromIntegral) <$> (circuit ++ [s])
+
+  -- is this a counterclockwise turn?
+  ccw (ax,ay) (bx,by) (cx,cy) = (cy-ay) * (bx-ax) > (by-ay) * (cx-ax)
+  -- line-line intersection
+  llintersect (a,b) (c,d) = ccw a c d /= ccw b c d && ccw a b c /= ccw a b d
+  
+  -- a tile is inside the circuit if it intersects an odd amount of edges
+  inside tile@(x,_) = foldl (/=) False $ llintersect (both fromIntegral $ tile,(fromIntegral x,1/0)) <$> pairwise offgrid
+
+  -- all tiles that dont lie on the circuit that are inside it
+  enclosed = filter inside $ (vertexList g) \\ circuit
+
+main = readFile "input.txt" >>= (putStrLn . show . part2 . lines)
-- 
cgit 1.4.1