this post was submitted on 16 Dec 2023
18 points (100.0% liked)

Advent Of Code

770 readers
67 users here now

An unofficial home for the advent of code community on programming.dev!

Advent of Code is an annual Advent calendar of small programming puzzles for a variety of skill sets and skill levels that can be solved in any programming language you like.

AoC 2023

Solution Threads

M T W T F S S
1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25

Rules/Guidelines

Relevant Communities

Relevant Links

Credits

Icon base by Lorc under CC BY 3.0 with modifications to add a gradient

console.log('Hello World')

founded 1 year ago
MODERATORS
 

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

you are viewing a single comment's thread
view the rest of the comments
[โ€“] lwhjp@lemmy.sdf.org 2 points 11 months ago

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!