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

  • gentooerEnglish
    3·
    7 hours ago

    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