1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
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)
|