lwhjp, 5 months ago Haskell A pretty by-the-book “walk all paths” algorithm. This could be made a lot faster with some caching. Solutionimport 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.unionbeams 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 inputA whopping 130.050 line-seconds!
A pretty by-the-book “walk all paths” algorithm. This could be made a lot faster with some caching.
Solutionimport 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.unionbeams 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 inputA whopping 130.050 line-seconds!
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
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’
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