Day 18: Lavaduct Lagoon

Well, for part 2 I didn't have quite the right answer, but I suspected kind of what was going wrong. So I tried to fix it. But that didn't work. So then I added a factor of 2 to the thing it was off by, and it was off by 1. So then I added one. And then it was correct on both the test & input cases!

Do I know why it was off by the factor of 2 or 1? Nope!!

edit: fixed,

I did look at the result by zooming way out in notepad++ and clicking randomly in the center to find a valid starting square for my flood fill.

I thought it was an off by "1" for the perimeter, but adding the perimeter to the answer didn't work. So then I was like "YOLO divide by 2" and then it was only off by 1 so I just /2 the perimeter and then +1 and it was correct for the main input. Yay!

Nothing clever with this one, just stepped out the border into a set of coordinates and then flood-filled. I cheated a little by inspecting the border and checking where I could place the first point to ensure it was inside the bounds, so this could fail for a more generic input case.

type Instruction = (Direction, Integer)
data Direction = North | South | East | West deriving (Eq, Show)
type Coord = (Integer, Integer)
type TrenchMap = Set Coord

moveDirN :: Integer -> Direction -> Coord -> Coord
moveDirN n North (r, c) = (r-n, c)
moveDirN n South (r, c) = (r+n, c)
moveDirN n East (r, c) = (r, c+n)
moveDirN n West (r, c) = (r, c-n)

moveDir :: Direction -> Coord -> Coord
moveDir = moveDirN 1

neighbors :: Coord -> [Coord]
neighbors (r, c) = [(r+1, c), (r-1, c), (r, c+1), (r, c-1)]

parseInput1 :: String -> [Instruction]
parseInput1 input = map parseRow (lines input) where
    parseRow row = (direction, distance) where
        [dir, dist, col] = words row
        direction = case head dir of
            'R' -> East
            'L' -> West
            'U' -> North
            'D' -> South
        distance = read dist

solve1 :: [Instruction] -> Int
solve1 input = result where
    trench = digTrench (0, 0) Set.empty input
    fill = floodFill (1, 1) trench
    result = Set.size fill + Set.size trench
    digTrench :: Coord -> Set Coord -> [Instruction] -> Set Coord
    digTrench _ trenchMap [] = trenchMap
    digTrench pos trenchMap ((direction, distance):xs) = digTrench pos' trenchMap' xs where
        (pos', trenchMap') = digLine pos trenchMap distance
        digLine p tMap 0 = (p, tMap)
        digLine p tMap d = digLine (moveDir direction p) (Set.insert p tMap) (d-1)

floodFill :: Coord -> Set Coord -> Set Coord
floodFill startingPos walls = flood [startingPos] walls Set.empty where
    flood [] _ seen = seen
    flood (x:xs) walls seen
        | Set.member x seen = flood xs walls seen
        | Set.member x walls = flood xs walls seen
        | otherwise = flood (neighbors x ++ xs) walls (Set.insert x seen)

While probably not the most elegant solution, I'm fairly proud of coming up with this one: first I sliced the space on horizontal and vertical lines through every corner point, creating an irregular grid of rectangles. Each of these rectangles should be wholly inside or outside the shape, so I can just filter for the ones inside the shape and then add up their areas. Accounting for overlapping edges/corners was kind of a pain, but otherwise not too bad.

I'm glad I remembered a trick for identifying whether a point is inside a polygon: draw a ray from the point in any direction and count the number of edges that the ray crosses, if it's odd it's inside the shape!

type Rectangle = (Coord, Coord)
type Line = (Coord, Coord)

area :: Rectangle -> Integer
area ((r1, c1), (r2, c2)) = (r2 - r1 + 1) * (c2 - c1 + 1)

lineLength :: Line -> Integer
lineLength ((r1, c1), (r2, c2))
    | r1 == r2 = abs (c2 - c1) + 1
    | c1 == c2 = abs (r2 - r1) + 1
    | otherwise = error "not a line"

rectangleCorners :: Rectangle -> [Coord]
rectangleCorners((r1, c1), (r2, c2)) = [(r1, c1), (r1, c2), (r2, c1), (r2, c2)]

rectangleLines :: Rectangle -> [Line]
rectangleLines ((r1, c1), (r2, c2)) = [
    ((r1, c1), (r1, c2)), 
    ((r1, c1), (r2, c1)), 
    ((r1, c2), (r2, c2)), 
    ((r2, c1), (r2, c2))
    ]

parseInput2 :: String -> [Instruction]
parseInput2 input = map parseRow (lines input) where
    parseRow row = (direction, distance) where
        row' = dropWhile (/='#') row
        dir = row' !! 6
        dist = take 5 $ drop 1 row'
        direction = case dir of
            '0' -> East
            '1' -> South
            '2' -> West
            '3' -> North
        distance = parseHex dist

solve2 :: [Instruction] -> Integer
solve2 input = filledArea - lineCorrection + pointCorrection where
    corners = findCorners (0, 0) input []
    rows = (Set.elems . Set.fromList) $ map fst corners
    cols = (Set.elems . Set.fromList) $ map snd corners
    rectangles = [((r1, c1), (r2, c2)) | (r1, r2) <- zip rows (tail rows), (c1, c2) <- zip cols (tail cols)]
    filledRectangles = filter inShape rectangles

    findCorners p [] pts = p : pts
    findCorners p ((dir, dist):inst) pts = findCorners (moveDirN dist dir p) inst (p : pts)

    filledArea = sum (map area filledRectangles)
    lineCorrection = findLineCorrection filledRectangles Set.empty
    pointCorrection = findPointCorrection filledRectangles

    inShape :: Rectangle -> Bool
    inShape ((r1, c1), (r2, c2)) = crossCount `mod` 2 == 1 where
        rAvg = (r1 + r2) `div` 2
        cAvg = (c1 + c2) `div` 2
        crossCount = length $ filter crossRight (zip corners (tail corners))
        crossRight ((r1, c1), (r2, c2)) = min r1 r2 < rAvg && rAvg < max r1 r2 && c1 > cAvg

    findLineCorrection :: [Rectangle] -> Set Line -> Integer
    findLineCorrection [] _ = 0
    findLineCorrection (rect:rects) seen = n + findLineCorrection rects seen' where
        seen' = foldr Set.insert seen $ rectangleLines rect
        n = sum $ map lineLength $ filter (`Set.member` seen) $ rectangleLines rect

    findPointCorrection :: [Rectangle] -> Integer
    findPointCorrection rects = pntCorrect allPoints where
        allPoints = concatMap rectangleCorners rects
        pntCorrect :: [Coord] -> Integer
        pntCorrect = genericLength . filter (==4) . Map.elems . counts

The color stuff was a red herring for me. I thought part 2 was going to be growing the colors from the edges to see how many of each were in the center fill area. But also, this grid was not anchored in the positive domain, so I spent some time implementing a sparse grid class. Still getting a lot of mileage out of the Coordinate direction handling.

But instead, part 2 was just big. I spent some time on a variation of the ray cast algorithm from earlier to make an implementation that did every cell in the row in a single pass. This was a lot faster, but still not fast enough. I figured there must be a geometric solution to the problem, so I went looking and found out about the shoelace algorithm. I'm not sure I entirely understand the proof, but the formula is clear enough. From there, it was just a matter of getting points from the instructions list and expanding them to the outside corners.