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

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

import Control.Arrow
import Control.Monad
import Control.Monad.RWS
import Control.Monad.Trans.Maybe
import Data.Array (inRange)
import Data.Char
import Data.Set qualified as S
import Text.ParserCombinators.ReadP hiding (get)

parse = fst . last . readP_to_S (endBy ((,) <$> num <*> (char ',' *> num)) $ char '\n')
 where
  num = read <$> munch1 isDigit

bounds = ((0, 0), (70, 70))

bfs :: MaybeT (RWS (S.Set (Int, Int)) () (S.Set (Int, Int), [(Int, (Int, Int))])) Int
bfs = do
  (seen, (c, x) : xs) <- get
  modify . second $ const xs
  isCorrupt <- asks (S.member x)

  when (not (x `S.member` seen) && not isCorrupt && inRange bounds x) $
    modify (S.insert x *** (++ ((succ c,) <$> neighbors x)))

  if x == snd bounds
    then return c
    else bfs

neighbors (x, y) = [(succ x, y), (pred x, y), (x, succ y), (x, pred y)]

findPath = fst . flip (evalRWS (runMaybeT bfs)) (mempty, [(0, (0, 0))]) . S.fromList

part1 = findPath . take 1024

search corrupt = go 0 (length corrupt)
 where
  go l r = case (findPath $ take (pred m) corrupt, findPath $ take m corrupt) of
    (Just _, Just _) -> go m r
    (Just _, Nothing) -> Just $ pred m
    (Nothing, Nothing) -> go l m
   where
    m = (l + r) `div` 2

part2 = liftM2 fmap (!!) search

main = getContents >>= print . (part1 &&& part2) . parse

use std::collections::VecDeque;

use euclid::{default::*, vec2};

fn parse(input: &str) -> Vec<Point2D<i32>> {
    input
        .lines()
        .map(|l| {
            let (x, y) = l.split_once(',').unwrap();
            Point2D::new(x.parse().unwrap(), y.parse().unwrap())
        })
        .collect()
}

const BOUNDS: Rect<i32> = Rect::new(Point2D::new(0, 0), Size2D::new(71, 71));
const START: Point2D<i32> = Point2D::new(0, 0);
const TARGET: Point2D<i32> = Point2D::new(70, 70);
const N_BYTES: usize = 1024;
const DIRS: [Vector2D<i32>; 4] = [vec2(1, 0), vec2(0, 1), vec2(-1, 0), vec2(0, -1)];

fn adj(
    field: &[[bool; BOUNDS.size.width as usize]],
    v: Point2D<i32>,
) -> impl Iterator<Item = Point2D<i32>> + use<'_> {
    DIRS.iter()
        .map(move |&d| v + d)
        .filter(|&next| BOUNDS.contains(next) && !field[next.y as usize][next.x as usize])
}

fn find_path(field: &[[bool; BOUNDS.size.width as usize]]) -> Option<u32> {
    let mut seen = [[false; BOUNDS.size.width as usize]; BOUNDS.size.height as usize];
    let mut q = VecDeque::from([(START, 0)]);
    seen[START.y as usize][START.x as usize] = true;
    while let Some((v, dist)) = q.pop_front() {
        for w in adj(field, v) {
            if w == TARGET {
                return Some(dist + 1);
            }
            if !seen[w.y as usize][w.x as usize] {
                seen[w.y as usize][w.x as usize] = true;
                q.push_back((w, dist + 1));
            }
        }
    }
    None
}

fn part1(input: String) {
    let bytes = parse(&input);
    let mut field = [[false; BOUNDS.size.width as usize]; BOUNDS.size.height as usize];
    for b in &bytes[..N_BYTES] {
        field[b.y as usize][b.x as usize] = true;
    }
    println!("{}", find_path(&field).unwrap());
}

fn part2(input: String) {
    let bytes = parse(&input);
    let mut field = [[false; BOUNDS.size.width as usize]; BOUNDS.size.height as usize];
    for (i, b) in bytes.iter().enumerate() {
        field[b.y as usize][b.x as usize] = true;
        // We already know from part 1 that below N_BYTES there is a path
        if i > N_BYTES && find_path(&field).is_none() {
            println!("{},{}", b.x, b.y);
            break;
        }
    }
}

util::aoc_main!();

/// Returns cost to destination, plus list of routes to destination.
/// Does Dijkstra/A* search depending on whether heuristic returns 1 or
/// something better.
(num, List<List<T>>) aStarSearch<T>(T start, Map<T, num> Function(T) fNext,
    int Function(T) fHeur, bool Function(T) fAtEnd,
    {multiplePaths = false}) {
  var cameFrom = SetMultimap<T, T>.fromEntries([MapEntry(start, start)]);

  var ends = <T>{};
  var front = PriorityQueue<T>((a, b) => fHeur(a).compareTo(fHeur(b)))
    ..add(start);
  var cost = <T, num>{start: 0};
  while (front.isNotEmpty) {
    var here = front.removeFirst();
    if (fAtEnd(here)) {
      ends.add(here);
      continue;
    }
    var ns = fNext(here);
    for (var n in ns.keys) {
      var nCost = cost[here]! + ns[n]!;
      if (!cost.containsKey(n) || nCost < cost[n]!) {
        cost[n] = nCost;
        front.add(n);
        cameFrom.removeAll(n);
        cameFrom[n].add(here);
      }
      if (multiplePaths && cost[n] == nCost) cameFrom[n].add(here);
    }
  }

  Iterable<List<T>> routes(T h) sync* {
    if (h == start) {
      yield [h];
      return;
    }
    for (var p in cameFrom[h]) {
      yield* routes(p).map((e) => e + [h]);
    }
  }

  if (ends.isEmpty) return (-1, []);
  var minCost = ends.map((e) => cost[e]!).min;
  ends = ends.where((e) => cost[e]! == minCost).toSet();
  return (minCost, ends.fold([], (s, t) => s..addAll(routes(t).toList())));
}

import Control.Monad
import Data.Ix
import Data.List
import Data.Map qualified as Map
import Data.Maybe
import Data.Set (Set)
import Data.Set qualified as Set

readInput :: String -> [(Int, Int)]
readInput = map readCoords . lines
  where
    readCoords l = let (a, _ : b) = break (== ',') l in (read a, read b)

findRoute :: (Int, Int) -> Set (Int, Int) -> Maybe [(Int, Int)]
findRoute goal blocked = go Set.empty (Map.singleton (0, 0) [])
  where
    go seen paths
      | Map.null paths = Nothing
      | otherwise =
          (paths Map.!? goal)
            `mplus` let seen' = Set.union seen (Map.keysSet paths)
                        paths' =
                          (`Map.withoutKeys` seen')
                            . foldl' (flip $ uncurry Map.insert) Map.empty
                            . concatMap (\(p, path) -> (,p : path) <$> step p)
                            $ Map.assocs paths
                     in go seen' paths'
    step (x, y) = do
      (dx, dy) <- [(0, -1), (0, 1), (-1, 0), (1, 0)]
      let p' = (x + dx, y + dy)
      guard $ inRange ((0, 0), goal) p'
      guard $ p' `Set.notMember` blocked
      return p'

dropAndFindRoutes goal skip bytes =
  let drops = drop skip $ zip bytes $ drop 1 $ scanl' (flip Set.insert) Set.empty bytes
   in zip (map fst drops) $ scanl' go (findRoute goal (snd $ head drops)) $ tail drops
  where
    go route (p, blocked) = do
      r <- route
      if p `elem` r then findRoute goal blocked else route

main = do
  input <- readInput <$> readFile "input18"
  let routes = dropAndFindRoutes (70, 70) 1024 input
  print $ length <$> (snd . head) routes
  print $ fst <$> find (isNothing . snd) routes

import Control.Arrow
import Control.Monad
import Data.Bifunctor hiding (first, second)

import Data.Set (Set)
import Data.Map (Map)

import qualified Data.List as List
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe

parse :: String -> [(Int, Int)]
parse = map (join bimap read) . map (break (== ',') >>> second (drop 1)) . filter (/= "") . lines

lowerBounds = (0, 0)
exitPosition = (70, 70)
initialBytes = 1024

adjacent (py, px) = Set.fromDistinctAscList [(py-1, px), (py, px-1), (py, px+1), (py+1, px)]

data Cost = Wall | Explored Int
        deriving (Show, Eq)

inBounds (py, px)
        | py < 0 = False
        | px < 0 = False
        | py > fst exitPosition = False
        | px > snd exitPosition = False
        | otherwise = True

dijkstra :: Map Int (Set (Int, Int)) -> Map (Int, Int) Cost -> (Int, (Int, Int), Map (Int, Int) Cost)
dijkstra queue walls
        | Map.null queue = (-1, (-1, -1), Map.empty)
        | minPos == exitPosition = (minKey, minPos, walls)
        | Maybe.isJust (walls Map.!? minPos) = dijkstra remainingQueue' walls
        | not . inBounds $ minPos = dijkstra remainingQueue' walls
        | otherwise = dijkstra neighborQueue updatedWalls
        where
                ((minKey, posSet), remainingQueue) = Maybe.fromJust . Map.minViewWithKey $ queue
                (minPos, remainingPosSet) = Maybe.fromJust . Set.minView $ posSet
                remainingQueue' = if not . Set.null $ remainingPosSet then Map.insert minKey remainingPosSet remainingQueue else remainingQueue
                neighborQueue = List.foldl (\ m n -> Map.insertWith (Set.union) neighborKey (Set.singleton n) m) remainingQueue' neighbors
                updatedWalls = Map.insert minPos (Explored minKey) walls
                neighborKey = minKey + 1
                neighbors = adjacent minPos

isExplored :: Cost -> Bool
isExplored Wall = False
isExplored (Explored _) = True

findPath :: Int -> (Int, Int) -> Map (Int, Int) Cost -> [(Int, Int)]
findPath n p ts
        | p == lowerBounds = [lowerBounds]
        | n == 0 = error "Out of steps when tracing backwards"
        | List.null neighbors = error "No matching neighbors when tracing backwards"
        | otherwise = p : findPath (pred n) (fst . head $ neighbors) ts
        where
                neighbors = List.filter ((== Explored (pred n)) . snd) . List.filter (isExplored . snd) . List.map (join (,) >>> second (ts Map.!)) . List.filter inBounds . Set.toList . adjacent $ p

runDijkstra = flip zip (repeat Wall)
        >>> Map.fromList
        >>> dijkstra (Map.singleton 0 (Set.singleton lowerBounds))

fst3 :: (a, b, c) -> a
fst3 (a, _, _) = a

thrd :: (a, b, c) -> c
thrd (_, _, c) = c

part1 = take initialBytes
        >>> runDijkstra
        >>> \ (n, _, _) -> n

firstFailing :: [(Int, Int)] -> [[(Int, Int)]] -> (Int, Int)
firstFailing path (bs:bss)
        | List.last bs `List.notElem` path = firstFailing path bss
        | c == (-1) = List.last bs
        | otherwise = firstFailing (findPath c p ts) bss
        where
                (c, p, ts) = runDijkstra bs

part2 bs = repeat
        >>> zip [initialBytes..length bs]
        >>> map (uncurry take)
        >>> firstFailing path
        $ bs
        where
                (n, p, ts) = runDijkstra . take 1024 $ bs
                path = findPath n p ts

main = getContents
        >>= print
        . (part1 &&& part2)
        . parse