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
2 points
C#
using QuickGraph;
using QuickGraph.Algorithms.ShortestPath;
namespace aoc24;
public class Day18 : Solver {
private int width = 71, height = 71, bytes = 1024;
private HashSet<(int, int)> fallen_bytes;
private List<(int, int)> fallen_bytes_in_order;
private record class Edge((int, int) Source, (int, int) Target) : IEdge<(int, int)>;
private DelegateVertexAndEdgeListGraph<(int, int), Edge> MakeGraph() => new(GetAllVertices(), GetOutEdges);
private readonly (int, int)[] directions = [(-1, 0), (0, 1), (1, 0), (0, -1)];
private bool GetOutEdges((int, int) arg, out IEnumerable<Edge> result_enumerable) {
List<Edge> result = [];
foreach (var (dx, dy) in directions) {
var (nx, ny) = (arg.Item1 + dx, arg.Item2 + dy);
if (nx < 0 || ny < 0 || nx >= width || ny >= height) continue;
if (fallen_bytes.Contains((nx, ny))) continue;
result.Add(new(arg, (nx, ny)));
}
result_enumerable = result;
return true;
}
private IEnumerable<(int, int)> GetAllVertices() {
for (int i = 0; i < width; i++) {
for (int j = 0; j < height; j++) {
yield return (i, j);
}
}
}
public void Presolve(string input) {
fallen_bytes_in_order = [..input.Trim().Split("\n")
.Select(line => line.Split(","))
.Select(pair => (int.Parse(pair[0]), int.Parse(pair[1])))];
fallen_bytes = [.. fallen_bytes_in_order.Take(bytes)];
}
private double Solve() {
var graph = MakeGraph();
var search = new AStarShortestPathAlgorithm<(int, int), Edge>(graph, _ => 1, vtx => vtx.Item1 + vtx.Item2);
search.SetRootVertex((0, 0));
search.ExamineVertex += vertex => {
if (vertex.Item1 == width - 1 && vertex.Item2 == width - 1) search.Abort();
};
search.Compute();
return search.Distances[(width - 1, height - 1)];
}
public string SolveFirst() => Solve().ToString();
public string SolveSecond() {
foreach (var b in fallen_bytes_in_order[bytes..]) {
fallen_bytes.Add(b);
if (Solve() > width*height) return $"{b.Item1},{b.Item2}";
}
throw new Exception("solution not found");
}
}
2 points
*
Haskell
Wasn’t there a pathfinding problem just recently?
Edit: Optimization to avoid recalculating paths all the time
Haskell with lambdas
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
2 points
Javascript
Reused my logic from Day 16. For part two I manually changed the bytes (i on line 271) to narrow in on a solution faster, but this solution should solve it eventually.
https://blocks.programming.dev/Zikeji/c8fdef54f78c4fb6a79cf1dc5551ff4d
2 points
Haskell
I did an easy optimization for part 2, but it’s not too slow without.
Solution
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
2 points
*
Dart
I knew keeping my search code from day 16 would come in handy, I just didn’t expect it to be so soon.
For Part 2 it finds that same path (laziness on my part), then does a simple binary chop to home in on the last valid path. (was then searches for the first block that will erm block that path, and re-runs the search after that block has dropped, repeating until blocked. Simple but okay. )
90 lines, half of which is my copied search method. Runs in a couple of seconds which isn’t great, but isn’t bad. Binary chop dropped it to 200ms.
import 'dart:math';
import 'package:collection/collection.dart';
import 'package:more/more.dart';
var d4 = <Point<num>>[Point(0, 1), Point(0, -1), Point(1, 0), Point(-1, 0)];
solve(List<String> lines, int count, Point end, bool inPart1) {
var blocks = (lines
.map((e) => e.split(',').map(int.parse).toList())
.map((p) => Point<num>(p[0], p[1]))).toList();
var blocksSofar = blocks.take(count).toSet();
var start = Point(0, 0);
Map<Point, num> fNext(Point here) => {
for (var d in d4
.map((d) => d + here)
.where((e) =>
e.x.between(start.x, end.x) &&
e.y.between(start.y, end.y) &&
!blocksSofar.contains(e))
.toList())
d: 1
};
int fHeur(Point here) => 1;
bool fAtEnd(Point here) => here == end;
var cost = aStarSearch<Point>(start, fNext, fHeur, fAtEnd);
if (inPart1) return cost.first;
var lo = count, hi = blocks.length;
while (lo <= hi) {
var mid = (lo + hi) ~/ 2;
blocksSofar = blocks.take(mid).toSet();
cost = aStarSearch<Point>(start, fNext, fHeur, fAtEnd);
(cost.first > 0) ? lo = mid + 1 : hi = mid - 1;
}
var p = blocks[lo - 1];
return '${p.x},${p.y}';
}
part1(lines, count, end) => solve(lines, count, end, true);
part2(lines, count, end) => solve(lines, count, end, false);
That search method
/// 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())));
}
