Day 18: Ram Run
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 are viewing a single thread.
View all comments 3 points
*
Haskell
Not really happy with performance, binary search would speed this up a bunch, takes about 1.3 seconds.
Update: Binary search got it to 960 ms.
Code
import Data.Maybe
import qualified Data.Set as S
type Coord = (Int, Int)
parse :: String -> [Coord]
parse = map (read . ('(' :) . (++ ")")) . takeWhile (not . null) . lines
shortest :: Coord -> [Coord] -> Maybe Int
shortest (x0, y0) corrupted' = go $ S.singleton (x0 - 1, y0 - 1)
where
corrupted = S.fromList corrupted'
inside (x, y)
| x < 0 = False
| y < 0 = False
| x0 <= x = False
| y0 <= y = False
| otherwise = True
grow cs = S.filter inside $ S.unions $ cs :
[ S.mapMonotonic (\(x, y) -> (x + dx, y + dy)) cs
| (dx, dy) <- [(-1, 0), (0, -1), (0, 1), (1, 0)]
]
go visited
| (0, 0) `S.member` visited = Just 0
| otherwise = case grow visited S.\\ corrupted of
visited'
| S.size visited == S.size visited' -> Nothing
| otherwise -> succ <$> go visited'
main :: IO ()
main = do
rs <- parse <$> getContents
let size = (71, 71)
print $ fromJust $ shortest size $ take 1024 rs
putStrLn $ init $ tail $ show $ last $ zipWith const (reverse rs) $
takeWhile (isNothing . shortest size) $ iterate init rs
Faster (binary search)
import Data.Maybe
import qualified Data.Set as S
type Coord = (Int, Int)
parse :: String -> [Coord]
parse = map (read . ('(' :) . (++ ")")) . takeWhile (not . null) . lines
shortest :: Coord -> [Coord] -> Maybe Int
shortest (x0, y0) corrupted' = go $ S.singleton (x0 - 1, y0 - 1)
where
corrupted = S.fromList corrupted'
inside (x, y)
| x < 0 = False
| y < 0 = False
| x0 <= x = False
| y0 <= y = False
| otherwise = True
grow cs = S.filter inside $ S.unions $ cs :
[ S.mapMonotonic (\(x, y) -> (x + dx, y + dy)) cs
| (dx, dy) <- [(-1, 0), (0, -1), (0, 1), (1, 0)]
]
go visited
| (0, 0) `S.member` visited = Just 0
| otherwise = case grow visited S.\\ corrupted of
visited'
| S.size visited == S.size visited' -> Nothing
| otherwise -> succ <$> go visited'
solve2 :: Coord -> [Coord] -> Coord
solve2 r0 corrupted = go 0 $ length corrupted
where
go a z
| succ a == z = corrupted !! a
| otherwise =
let x = (a + z) `div` 2
in case shortest r0 $ take x corrupted of
Nothing -> go a x
Just _ -> go x z
main :: IO ()
main = do
rs <- parse <$> getContents
let size = (71, 71)
print $ fromJust $ shortest size $ take 1024 rs
putStrLn $ init $ tail $ show $ solve2 size rs
