From 755dbc8076d7c07860a24150a07f0510a5dca452 Mon Sep 17 00:00:00 2001 From: Jordan Doyle Date: Sun, 10 Dec 2023 22:22:11 +0000 Subject: [PATCH] Add day 10 --- 2023/10.hs | 181 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 181 insertions(+) create mode 100755 2023/10.hs diff --git a/2023/10.hs b/2023/10.hs new file mode 100755 index 0000000..75a3d8f --- /dev/null +++ b/2023/10.hs @@ -0,0 +1,181 @@ +#!/usr/bin/env nix-shell +#!nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])" + +import Data.List +import Data.Maybe (listToMaybe) +import qualified Data.Set as Set +import Text.Parsec +import Text.Parsec.Char +import Text.Parsec.Combinator +import Text.Parsec.String (Parser) + +main = do + input <- buildPipeLoop <$> readAndParseStdin + print $ part1 input + print $ part2 input + +-- returns the first part of the loop +part1 :: [Direction] -> Int +part1 directions = fromIntegral (length directions) `div` 2 + +-- find the enclosed area of the loop +part2 :: [Direction] -> Int +part2 directions = + let vertices = findVertices directions + boundaryPoints = countBoundaryPoints vertices + in ceiling $ picksTheorem (shoelace vertices) boundaryPoints + +-- finds all the vertices for the given closed loop +findVertices :: [Direction] -> [(Int, Int)] +findVertices directions = (0, 0) : run (1, 0) (head directions) (tail directions) + where + run :: (Int, Int) -> Direction -> [Direction] -> [(Int, Int)] + run coords direction [x] = [coords | direction /= x] + run coords direction (x : xs) = + let recurse = run (nextGridPosition coords x) x xs + in if direction /= x then coords : recurse else recurse + +-- count the boundary points +countBoundaryPoints :: [(Int, Int)] -> Int +countBoundaryPoints vertices = sum (zipWith boundaryPoints vertices (tail vertices)) - length vertices + where + boundaryPoints (x1, y1) (x2, y2) = abs (x2 - x1) + abs (y2 - y1) + 1 + +-- use pick's theorem to find the interior lattice points +picksTheorem :: Double -> Int -> Double +picksTheorem area boundaryPoints = area - (fromIntegral boundaryPoints / 2) + 1 + +-- calculates the area for the polygon described by the set of +-- verticies using the shoelace formula +shoelace :: [(Int, Int)] -> Double +shoelace vertices = + let pairs = zip vertices $ tail vertices + sumProd (x1, y1) (x2, y2) = x1 * y2 - x2 * y1 + in fromIntegral (abs . sum $ zipWith sumProd vertices (tail vertices)) / 2 + +-- builds the list of directions that forms the pipe loop +buildPipeLoop :: [[Tile]] -> [Direction] +buildPipeLoop grid = + let startingPosition = findStartingPosition grid + initialDirection = case listToMaybe [d | d <- directions, Just (x, y, tile) <- [findNext grid startingPosition d], isValidFromDirection d tile] of + Just o -> o + Nothing -> error "invalid starting point, no connected points" + in run startingPosition initialDirection + where + run :: (Int, Int) -> Direction -> [Direction] + run coords direction = + case findNext grid coords direction of + Just (_, _, Start) -> [direction] + Just (nextX, nextY, tile) -> direction : run (nextX, nextY) (nextDirection direction tile) + Nothing -> error $ show (coords, direction) + +-- looks for a connecting pipe in the given direction, returning Nothing if that direction +-- is invalid +findNext :: [[Tile]] -> (Int, Int) -> Direction -> Maybe (Int, Int, Tile) +findNext tiles (x, y) direction + | isValidDirection = + let (nextX, nextY) = nextGridPosition (x, y) direction + nextTile = getTile tiles nextX nextY + in Just (nextX, nextY, nextTile) + | otherwise = Nothing + where + isValidDirection = + case direction of + North -> y > 0 + West -> x > 0 + South -> y < length tiles - 1 + East -> x < length (head tiles) - 1 + +-- finds the next grid position given the current coords and direction to use +nextGridPosition :: (Int, Int) -> Direction -> (Int, Int) +nextGridPosition (x, y) direction = + let (dX, dY) = directionDelta direction + in (x + dX, y + dY) + +-- finds the starting coordinates in our input +findStartingPosition :: [[Tile]] -> (Int, Int) +findStartingPosition tiles = case listToMaybe [(x, y) | (y, row) <- zip [0 ..] tiles, (x, val) <- zip [0 ..] row, val == Start] of + Just v -> v + Nothing -> error "input contains no starting tile" + +-- read and parse stdin +readAndParseStdin :: IO [[Tile]] +readAndParseStdin = do + content <- getContents + case parse parseInput "" content of + Left parseError -> error $ show parseError + Right doc -> return doc + +-- parse each input line +parseInput :: Parser [[Tile]] +parseInput = parseLine `sepBy` char '\n' + +-- parse an incoming line +parseLine :: Parser [Tile] +parseLine = many1 parseTile + +-- parses a single tile +parseTile :: Parser Tile +parseTile = + choice + [ NorthSouth <$ char '|', + EastWest <$ char '-', + NorthEast <$ char 'L', + NorthWest <$ char 'J', + SouthWest <$ char '7', + SouthEast <$ char 'F', + Ground <$ char '.', + Start <$ char 'S' + ] + +data Direction = North | East | South | West deriving (Show, Enum, Eq) + +-- list of all known directions on planet earth +directions :: [Direction] +directions = [North, East, South, West] + +-- inverts a direction +invertDirection :: Direction -> Direction +invertDirection North = South +invertDirection South = North +invertDirection East = West +invertDirection West = East + +-- maps a step in a direction to a delta on a 2d grid +directionDelta :: Direction -> (Int, Int) +directionDelta North = (0, -1) +directionDelta South = (0, 1) +directionDelta East = (1, 0) +directionDelta West = (-1, 0) + +data Tile = NorthSouth | EastWest | NorthEast | NorthWest | SouthWest | SouthEast | Ground | Start deriving (Show, Enum, Eq) + +-- grabs a tile at the given coordinates +getTile :: [[Tile]] -> Int -> Int -> Tile +getTile tiles x y = tiles !! y !! x + +-- returns the directions the pipe connects +connectedDirections :: Tile -> Maybe (Direction, Direction) +connectedDirections tile = case tile of + NorthSouth -> Just (North, South) + EastWest -> Just (East, West) + NorthEast -> Just (North, East) + NorthWest -> Just (North, West) + SouthWest -> Just (South, West) + SouthEast -> Just (South, East) + _ -> Nothing + +-- checks if coming from the given direction is valid for the tile +isValidFromDirection :: Direction -> Tile -> Bool +isValidFromDirection incoming tile = + let inverted = invertDirection incoming + in case connectedDirections tile of + Just (l, r) | l == inverted || r == inverted -> True + _ -> False + +-- given the incoming direction, returns the next direction the pipe turns to +nextDirection :: Direction -> Tile -> Direction +nextDirection incoming tile = case connectedDirections tile of + Just (l, r) | l == invertDirection incoming -> r + Just (l, r) | r == invertDirection incoming -> l + _ -> error $ show (incoming, tile) -- libgit2 1.7.2