Skip to content

Instantly share code, notes, and snippets.

@skatenerd

skatenerd/day_ten_2023.hs

Created December 12, 2023 04:59
Show Gist options
  • Save skatenerd/7a1288883425c0e87bf1a7027fcd7b87 to your computer and use it in GitHub Desktop.
Save skatenerd/7a1288883425c0e87bf1a7027fcd7b87 to your computer and use it in GitHub Desktop.
Download ZIP
Day 10 AOC 2023
Raw
day_ten_2023.hs
{-# LANGUAGE OverloadedStrings #-}
module DayTen where
import qualified Data.Text as T
import qualified Data.List as L
import qualified Text.Read as TR
import Debug.Trace (traceShowId, traceShow)
import qualified Data.Maybe as M
import qualified Data.Set as S
import Safe (atDef, atMay, minimumMay, headMay)
gridAt :: [[a]] -> (Int, Int) -> Maybe a
gridAt items (rowIdx, colIdx) = row `atMay` colIdx
where row = items `atRow` rowIdx
atRow = atDef []
data Tile = Vertical | Horizontal | NE | NW | SW | SE | Ground | Start deriving (Show, Ord, Eq)
isVerticalBar Vertical = True
isVerticalBar _ = False
isHorizontalBar Horizontal = True
isHorizontalBar _ = False
isCorner NE = True
isCorner NW = True
isCorner SE = True
isCorner SW = True
isCorner _ = False
data Node = Node (Int, Int) Tile [Node]
instance Show Node
where show (Node coordinates tile neighbors) = (show coordinates) ++ " " ++ (show tile) ++ " [" ++ L.intercalate ", " (map showCheap neighbors) ++ "]"
where showCheap (Node coordinates tile neighbors) = (show coordinates) ++ " " ++ (show tile)
getNeighbors (Node _ _ neighbors) = neighbors
getTile (Node _ tile _) = tile
getCoordinates (Node idx _ _) = idx
instance Ord Node
where compare (Node firstCoordinates _ _) (Node secondCoordinates _ _) = compare firstCoordinates secondCoordinates
instance Eq Node
where (Node firstCoordinates _ _) == (Node secondCoordinates _ _) = firstCoordinates == secondCoordinates
isSeed (Node _ Start _) = True
isSeed _ = False
goNorth (row,col) = (row - 1, col)
goSouth (row,col) = (row + 1, col)
goEast (row,col) = (row, col + 1)
goWest (row,col) = (row, col - 1)
neighborIndices Vertical (row,col) = [goNorth (row,col), goSouth (row,col)]
neighborIndices Horizontal (row,col) = [goEast (row, col), goWest (row,col)]
neighborIndices NE (row,col) = [goNorth (row, col), goEast (row,col)]
neighborIndices NW (row,col) = [goNorth (row, col), goWest (row,col)]
neighborIndices SE (row,col) = [goSouth (row, col), goEast (row,col)]
neighborIndices SW (row,col) = [goSouth (row, col), goWest (row,col)]
neighborIndices _ (row,col) = []
testInput :: [T.Text]
testInput = ["7-F7-",
".FJ|7",
"SJLL7",
"|F--J",
"LJ.LJ"]
parseTile '|' = Vertical
parseTile '-' = Horizontal
parseTile 'L' = NE
parseTile 'J' = NW
parseTile '7' = SW
parseTile 'F' = SE
parseTile 'S' = Start
parseTile _ = Ground
parseGrid :: [T.Text] -> [[Tile]]
parseGrid = map (pad . (map parseTile) . T.unpack)
where pad tiles = tiles
buildIdxGrid parsedInput = (map (\idx -> (map (\ri -> (idx, ri)) row)) colIdxs)
where colIdxs = 0 `enumFromTo` (height - 1)
row = 0 `enumFromTo` (width - 1)
height = length parsedInput
width = length $ head parsedInput
crudeNeighbors grid node@(Node coordinates tile _) = (M.catMaybes (map (grid `gridAt`) (neighborIndices tile coordinates)))
getStart graph = head $ filter isSeed $ concat graph
mutualNeighbors grid node@(Node coordinates tile _) = filter pointsBack (crudeNeighbors grid node)
where pointsBack neighbor
| isSeed neighbor = True
| otherwise = any (== node) (crudeNeighbors grid neighbor)
buildGraph parsedInput = answer
where coordinateTemplate = buildIdxGrid parsedInput
answer = map (M.catMaybes . (map buildNode)) coordinateTemplate
buildNode (row,col) = do
tile <- (parsedInput `gridAt` (row, col))
let node = Node (row,col) tile (mutualNeighbors answer node) -- note that we are passing in 'node'...to build 'node'
return node
followToEnd seenSoFar current@(Node _ Start neighbors) = [current]
followToEnd seenSoFar current@(Node _ _ neighbors) = current : new
where new = concatMap (followToEnd (S.insert current seenSoFar)) $ viableNeighbors
viableNeighbors = filter (\x -> (getTile x) /= Start) (S.toList $ (S.fromList neighbors) S.\\ seenSoFar)
partOne parsed = [length (followToEnd (S.fromList []) righted), length (followToEnd (S.fromList []) upped)]
where start@(Node startCoords _ _) = getStart graph
graph = buildGraph parsed
upped = M.fromJust $ graph `gridAt` (goNorth startCoords)
righted = M.fromJust $ graph `gridAt` (goEast startCoords)
partTwoTest :: [T.Text]
partTwoTest = ["..........",
".S------7.",
".|F----7|.",
".||....||.",
".||....||.",
".|L-7F-J|.",
".|..||..|.",
".L--JL--J.",
".........."]
partTwoSecondTest :: [T.Text]
partTwoSecondTest = ["FF7FSF7F7F7F7F7F---7",
"L|LJ||||||||||||F--J",
"FL-7LJLJ||||||LJL-77",
"F--JF--7||LJLJ7F7FJ-",
"L---JF-JLJ.||-FJLJJ7",
"|F|F-JF---7F7-L7L|7|",
"|FFJF7L7F-JF7|JL---7",
"7-L-JL7||F7|L7F-7F7|",
"L.L7LFJ|||||FJL7||LJ",
"L7JLJL-JLJLJL--JLJ.L"]
isLoop grid path = length path >= 8 && (isClosed || touchesStartTwice)
where endOfLoop = last $ path
touchesStartTwice = length (filter isNeighborOfStart path) == 2
isNeighborOfStart node = any (\n -> (getTile n == Start)) (getNeighbors node)
isClosed = (S.fromList $ concatMap (crudeNeighbors grid) path) == pathSet
pathSet = S.fromList path
allLoops grid = foldl go ([], S.empty) allNodes
where allNodes = concat grid
go (loopsSeen, deadEndNodes) node
| any (elem node) loopsSeen = (loopsSeen, deadEndNodes)
| node `elem` deadEndNodes = (loopsSeen, deadEndNodes)
| isLoop grid fullPath = (fullPathSet:loopsSeen, deadEndNodes)
| otherwise = (loopsSeen, S.union deadEndNodes fullPathSet)
where fullPath = followToEnd S.empty node
fullPathSet = (S.fromList fullPath)
listInteriorAlongPath :: (S.Set Node) -> Int -> [Node] -> [Tile] -> Node -> [Node] -> [Node]
listInteriorAlongPath bdry crossingsCompleted interiorsFound cornersSeen currentLocation [] = interiorsFound
listInteriorAlongPath bdry crossingsCompleted interiorsFound cornersSeen currentLocation (head:rest)
| amOnBoundary && (not (adjacentBorder currentLocation head)) && (countsAsCrossing (headMay cornersSeen) (getTile currentLocation)) = listInteriorAlongPath bdry (crossingsCompleted + 1) newInteriors newCorners head rest
| otherwise = vanillaRecur
where newCorners
| isCorner currentTile = currentTile : cornersSeen
| otherwise = cornersSeen
currentTile = (getTile currentLocation)
vanillaRecur = listInteriorAlongPath bdry crossingsCompleted newInteriors newCorners head rest
amOnBoundary = (currentLocation `elem` bdry)
newInteriors
| (odd crossingsCompleted) && (not amOnBoundary) = currentLocation : interiorsFound
| otherwise = interiorsFound
countsAsCrossing (Just SW) NE = True
countsAsCrossing (Just SE) NW = True
countsAsCrossing (Just NW) SE = True
countsAsCrossing (Just NE) SW = True
countsAsCrossing _ Horizontal = True
countsAsCrossing _ Vertical = True
countsAsCrossing _ _ = False
-- To do part 2, find the longest loop in your grid, pass it in here.
-- Make sure you've replaced 'S' with the relevant pipe, in my case it was '|'
findInterior loop grid = concatMap doRow rowPaths
where rowPaths = (buildIdxGrid grid)
doRow rowPath = listInteriorAlongPath loop 0 [] [] (gl (head rowPath)) (map gl (tail rowPath))
gl = gridLookup grid
adjacentBorder a b = b `elem` (getNeighbors a)
gridLookup grid c = M.fromJust $ grid `gridAt` c
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment