🏡 index : ~doyle/aoc.git

2dfdbfc11b3256b72ea35773f6d5540e1b6b19a7 [patch]

bd1b3a159dde9e0203a144bd8b7be7b863a85ab1

d642bde642a33969417f57772c540a96180c72b0

2dfdbfc11b3256b72ea35773f6d5540e1b6b19a7.tar.gz

Add day 16

Diff

 2023/16.hs | 87 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 87 insertions(+)

diff --git a/2023/16.hs b/2023/16.hs
new file mode 100755
index 0000000..601d1cf
--- /dev/null
+++ b/2023/16.hs
@@ -0,0 +1,87 @@
#!/usr/bin/env nix-shell
#!nix-shell --pure -i "runghc -- -i../" -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])"

import Aoc (readAndParseStdin)
import qualified Data.Set as Set
import Text.Parsec (char, choice, many1, sepBy)
import Text.Parsec.String (Parser)

main = do
  input <- readAndParseStdin parseInput
  print $ part1 input
  print $ part2 input

part1 :: [[GridTile]] -> Int
part1 input = length $ traverseWithSeen input (0, 0, R)

part2 :: [[GridTile]] -> Int
part2 input =
  let maxY = length input - 1
      maxX = length (head input) - 1
      allStartingPositions = map (,0) [0 .. maxX] ++ map (0,) [0 .. maxY] ++ map (,maxY) [0 .. maxX] ++ map (maxX,) [0 .. maxY]
      allStartingPositionsWithHeadings = [(x, y, h) | (x, y) <- allStartingPositions, h <- allDirections]
   in maximum $ map (length . traverseWithSeen input) allStartingPositionsWithHeadings

traverseWithSeen :: [[GridTile]] -> (Int, Int, Heading) -> Set.Set (Int, Int)
traverseWithSeen grid (x, y, heading) = Set.map (\(x, y, heading) -> (x, y)) $ go (x, y) heading Set.empty
  where
    go :: (Int, Int) -> Heading -> Set.Set (Int, Int, Heading) -> Set.Set (Int, Int, Heading)
    go (x, y) heading acc =
      let newSet = Set.insert (x, y, heading) acc
       in if Set.member (x, y, heading) acc
            then acc
            else case getTile grid (x, y) of
              Just VertSplitter | isHorizontal heading -> go (nextPos (x, y) Up) Up $ go (nextPos (x, y) Down) Down newSet
              Just HorizSplitter | isVertical heading -> go (nextPos (x, y) L) L $ go (nextPos (x, y) R) R newSet
              Just v | v == RightSlantMirror || v == LeftSlantMirror -> go (nextPos (x, y) $ getNextDirection v heading) (getNextDirection v heading) newSet
              Just _ -> go (nextPos (x, y) heading) heading newSet
              Nothing -> acc

parseInput :: Parser [[GridTile]]
parseInput = many1 parseGridTile `sepBy` char '\n'

parseGridTile :: Parser GridTile
parseGridTile =
  choice
    [ Empty <$ char '.',
      RightSlantMirror <$ char '/',
      LeftSlantMirror <$ char '\\',
      VertSplitter <$ char '|',
      HorizSplitter <$ char '-'
    ]

data GridTile = Empty | RightSlantMirror | LeftSlantMirror | VertSplitter | HorizSplitter deriving (Enum, Show, Eq)

data Heading = Up | Down | L | R deriving (Enum, Show, Ord, Eq)

allDirections = [Up, Down, L, R]

getNextDirection :: GridTile -> Heading -> Heading
getNextDirection RightSlantMirror Up = R
getNextDirection RightSlantMirror Down = L
getNextDirection RightSlantMirror R = Up
getNextDirection RightSlantMirror L = Down
getNextDirection LeftSlantMirror Up = L
getNextDirection LeftSlantMirror Down = R
getNextDirection LeftSlantMirror R = Down
getNextDirection LeftSlantMirror L = Up

isHorizontal :: Heading -> Bool
isHorizontal L = True
isHorizontal R = True
isHorizontal _ = False

isVertical :: Heading -> Bool
isVertical = not . isHorizontal

getTile :: [[GridTile]] -> (Int, Int) -> Maybe GridTile
getTile g (x, y)
  | y >= length g || y < 0 = Nothing
  | x >= length (g !! y) || x < 0 = Nothing
  | otherwise = Just $ (g !! y) !! x

nextPos :: (Int, Int) -> Heading -> (Int, Int)
nextPos (x, y) Up = (x, y - 1)
nextPos (x, y) Down = (x, y + 1)
nextPos (x, y) L = (x - 1, y)
nextPos (x, y) R = (x + 1, y)