π¦ - 2023 DAY 16 SOLUTIONS -π¦
π¦ - 2023 DAY 16 SOLUTIONS -π¦
Day 16: The Floor Will Be Lava
Megathread guidelines
- Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
- You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL
FAQ
- What is this?: Here is a post with a large amount of details: https://programming.dev/post/6637268
- Where do I participate?: https://adventofcode.com/
- Is there a leaderboard for the community?: We have a programming.dev leaderboard with the info on how to join in this post: https://programming.dev/post/6631465
You're viewing a single thread.
All comments
12
comments
Haskell
A bit of a mess, I probably shouldn't have used RWS ...
import Control.Monad.RWS import Control.Parallel.Strategies import Data.Array import qualified Data.ByteString.Char8 as BS import Data.Foldable (Foldable (maximum)) import Data.Set import Relude data Cell = Empty | VertSplitter | HorizSplitter | Slash | Backslash deriving (Show, Eq) type Pos = (Int, Int) type Grid = Array Pos Cell data Direction = N | S | E | W deriving (Show, Eq, Ord) data BeamHead = BeamHead { pos :: Pos, dir :: Direction } deriving (Show, Eq, Ord) type Simulation = RWS Grid (Set Pos) (Set BeamHead) next :: BeamHead -> BeamHead next (BeamHead p d) = BeamHead (next' d p) d where next' :: Direction -> Pos -> Pos next' direction = case direction of N -> first pred S -> first succ E -> second succ W -> second pred advance :: BeamHead -> Simulation [BeamHead] advance bh@(BeamHead position direction) = do grid <- ask seen <- get if inRange (bounds grid) position && bh `notMember` seen then do tell $ singleton position modify $ insert bh pure . fmap next $ case (grid ! position, direction) of (Empty, _) -> [bh] (VertSplitter, N) -> [bh] (VertSplitter, S) -> [bh] (HorizSplitter, E) -> [bh] (HorizSplitter, W) -> [bh] (VertSplitter, _) -> [bh {dir = N}, bh {dir = S}] (HorizSplitter, _) -> [bh {dir = E}, bh {dir = W}] (Slash, N) -> [bh {dir = E}] (Slash, S) -> [bh {dir = W}] (Slash, E) -> [bh {dir = N}] (Slash, W) -> [bh {dir = S}] (Backslash, N) -> [bh {dir = W}] (Backslash, S) -> [bh {dir = E}] (Backslash, E) -> [bh {dir = S}] (Backslash, W) -> [bh {dir = N}] else pure [] simulate :: [BeamHead] -> Simulation () simulate heads = do heads' <- foldMapM advance heads unless (Relude.null heads') $ simulate heads' runSimulation :: BeamHead -> Grid -> Int runSimulation origin g = size . snd . evalRWS (simulate [origin]) g $ mempty part1, part2 :: Grid -> Int part1 = runSimulation $ BeamHead (0, 0) E part2 g = maximum $ parMap rpar (`runSimulation` g) possibleInitials where ((y0, x0), (y1, x1)) = bounds g possibleInitials = join [ [BeamHead (y0, x) S | x <- [x0 .. x1]], [BeamHead (y1, x) N | x <- [x0 .. x1]], [BeamHead (y, x0) E | y <- [y0 .. y1]], [BeamHead (y, x1) W | y <- [y0 .. y1]] ] parse :: ByteString -> Maybe Grid parse input = do let ls = BS.lines input h = length ls w <- BS.length <$> viaNonEmpty head ls mat <- traverse toCell . BS.unpack $ BS.concat ls pure $ listArray ((0, 0), (h - 1, w - 1)) mat where toCell '.' = Just Empty toCell '|' = Just VertSplitter toCell '-' = Just HorizSplitter toCell '/' = Just Slash toCell '\\' = Just Backslash toCell _ = Nothing
1 0 Reply
12
comments
Scroll to top