Haskell
A pretty by-the-book "walk all paths" algorithm. This could be made a lot faster with some caching.
Solution
import Control.Monad
import Data.Array.Unboxed (UArray)
import qualified Data.Array.Unboxed as A
import Data.Foldable
import Data.Set (Set)
import qualified Data.Set as Set
type Pos = (Int, Int)
readInput :: String -> UArray Pos Char
readInput s =
let rows = lines s
in A.listArray ((1, 1), (length rows, length $ head rows)) $ concat rows
energized :: (Pos, Pos) -> UArray Pos Char -> Set Pos
energized start grid = go Set.empty $ Set.singleton start
where
go seen beams
| Set.null beams = Set.map fst seen
| otherwise =
let seen' = seen `Set.union` beams
beams' = Set.fromList $ do
((y, x), (dy, dx)) <- toList beams
d'@(dy', dx') <- case grid A.! (y, x) of
'/' -> [(-dx, -dy)]
'\\' -> [(dx, dy)]
'|' | dx /= 0 -> [(-1, 0), (1, 0)]
'-' | dy /= 0 -> [(0, -1), (0, 1)]
_ -> [(dy, dx)]
let p' = (y + dy', x + dx')
beam' = (p', d')
guard $ A.inRange (A.bounds grid) p'
guard $ beam' `Set.notMember` seen'
return beam'
in go seen' beams'
part1 = Set.size . energized ((1, 1), (0, 1))
part2 input = maximum counts
where
(_, (h, w)) = A.bounds input
starts =
concat $
[[((y, 1), (0, 1)), ((y, w), (0, -1))] | y <- [1 .. h]]
++ [[((1, x), (1, 0)), ((h, x), (-1, 0))] | x <- [1 .. w]]
counts = map (\s -> Set.size $ energized s input) starts
main = do
input <- readInput <$> readFile "input16"
print $ part1 input
print $ part2 input
A whopping 130.050 line-seconds!