Day 16: Reindeer Maze
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
5 points
C
Yay more grids! Seemed like prime Dijkstra or A* material but I went with an iterative approach instead!
I keep an array cost[y][x][dir], which is seeded at 1 for the starting location and direction. Then I keep going over the array, seeing if any valid move (step or turn) would yield to a lower best-known-cost for this state. It ends when a pass does not yield changes.
This leaves us with the best-known-costs for every reachable state in the array, including the end cell (bit we have to take the min() of the four directions).
Part 2 was interesting: I just happend to have written a dead end pruning function for part 1 and part 2 is, really, dead-end pruning for the cost map: remove any suboptimal step, keep doing so, and you end up with only the optimal steps. ‘Suboptimal’ here is a move that yields a higher total cost than the best-known-cost for that state.
It’s fast enough too on my 2015 i5:
day16 0:00.05 1656 Kb 0+242 faults
Code
#include "common.h"
#define GZ 145
enum {NN, EE, SS, WW};
static const int dx[]={0,1,0,-1}, dy[]={-1,0,1,0};
static char g[GZ][GZ]; /* with 1 tile border */
static int cost[GZ][GZ][4]; /* per direction, starts at 1, 0=no info */
static int traversible(char c) { return c=='.' || c=='S' || c=='E'; }
static int
minat(int x, int y)
{
int acc=0, d;
for (d=0; d<4; d++)
if (cost[y][x][d] && (!acc || cost[y][x][d] < acc))
acc = cost[y][x][d];
return acc;
}
static int
count_exits(int x, int y)
{
int acc=0, i;
assert(x>0); assert(x<GZ-1);
assert(y>0); assert(y<GZ-1);
for (i=0; i<4; i++)
acc += traversible(g[y+dy[i]][x+dx[i]]);
return acc;
}
/* remove all dead ends */
static void
prune_dead(void)
{
int dirty=1, x,y;
while (dirty) {
dirty = 0;
for (y=1; y<GZ-1; y++)
for (x=1; x<GZ-1; x++)
if (g[y][x]=='.' && count_exits(x,y) < 2)
{ dirty = 1; g[y][x] = '#'; }
}
}
/* remove all dead ends from cost[], leaves only optimal paths */
static void
prune_subopt(void)
{
int dirty=1, x,y,d;
while (dirty) {
dirty = 0;
for (y=1; y<GZ-1; y++)
for (x=1; x<GZ-1; x++)
for (d=0; d<4; d++) {
if (!cost[y][x][d])
continue;
if (g[y][x]=='E') {
if (cost[y][x][d] != minat(x,y))
{ dirty = 1; cost[y][x][d] = 0; }
continue;
}
if (cost[y][x][d]+1 > cost[y+dy[d]][x+dx[d]][d] &&
cost[y][x][d]+1000 > cost[y][x][(d+1)%4] &&
cost[y][x][d]+1000 > cost[y][x][(d+3)%4])
{ dirty = 1; cost[y][x][d] = 0; }
}
}
}
static void
propagate_costs(void)
{
int dirty=1, cost1, x,y,d;
while (dirty) {
dirty = 0;
for (y=1; y<GZ-1; y++)
for (x=1; x<GZ-1; x++)
for (d=0; d<4; d++) {
if (!traversible(g[y][x]))
continue;
/* from back */
if ((cost1 = cost[y-dy[d]][x-dx[d]][d]) &&
(cost1+1 < cost[y][x][d] || !cost[y][x][d]))
{ dirty = 1; cost[y][x][d] = cost1+1; }
/* from right */
if ((cost1 = cost[y][x][(d+1)%4]) &&
(cost1+1000 < cost[y][x][d] || !cost[y][x][d]))
{ dirty = 1; cost[y][x][d] = cost1+1000; }
/* from left */
if ((cost1 = cost[y][x][(d+3)%4]) &&
(cost1+1000 < cost[y][x][d] || !cost[y][x][d]))
{ dirty = 1; cost[y][x][d] = cost1+1000; }
}
}
}
int
main(int argc, char **argv)
{
int p1=0,p2=0, sx=0,sy=0, ex=0,ey=0, x,y;
char *p;
if (argc > 1)
DISCARD(freopen(argv[1], "r", stdin));
for (y=1; fgets(g[y]+1, GZ-1, stdin); y++) {
if ((p = strchr(g[y]+1, 'S'))) { sy=y; sx=p-g[y]; }
if ((p = strchr(g[y]+1, 'E'))) { ey=y; ex=p-g[y]; }
assert(y+1 < GZ-1);
}
cost[sy][sx][EE] = 1;
prune_dead();
propagate_costs();
prune_subopt();
p1 = minat(ex, ey) -1; /* costs[] values start at 1! */
for (y=1; y<GZ-1; y++)
for (x=1; x<GZ-1; x++)
p2 += minat(x,y) > 0;
printf("16: %d %d\n", p1, p2);
return 0;
}
3 points
3 points
Haskell
Rather busy today so late and somewhat messy! (Probably the same tomorrow…)
import Data.List
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe
import Data.Set (Set)
import Data.Set qualified as Set
readInput :: String -> Map (Int, Int) Char
readInput s = Map.fromList [((i, j), c) | (i, l) <- zip [0 ..] (lines s), (j, c) <- zip [0 ..] l]
bestPath :: Map (Int, Int) Char -> (Int, Set (Int, Int))
bestPath maze = go (Map.singleton start (0, Set.singleton startPos)) (Set.singleton start)
where
start = (startPos, (0, 1))
walls = Map.keysSet $ Map.filter (== '#') maze
[Just startPos, Just endPos] = map (\c -> fst <$> find ((== c) . snd) (Map.assocs maze)) ['S', 'E']
go best edge
| Set.null edge = Map.mapKeysWith mergePaths fst best Map.! endPos
| otherwise =
let nodes' =
filter (\(x, (c, _)) -> maybe True ((c <=) . fst) $ best Map.!? x) $
concatMap (step . (\x -> (x, best Map.! x))) (Set.elems edge)
best' = foldl' (flip $ uncurry $ Map.insertWith mergePaths) best nodes'
in go best' $ Set.fromList (map fst nodes')
step ((p@(i, j), d@(di, dj)), (cost, path)) =
let rots = [((p, d'), (cost + 1000, path)) | d' <- [(-dj, di), (dj, -di)]]
moves =
[ ((p', d), (cost + 1, Set.insert p' path))
| let p' = (i + di, j + dj),
p `Set.notMember` walls
]
in moves ++ rots
mergePaths a@(c1, p1) b@(c2, p2) =
case compare c1 c2 of
LT -> a
GT -> b
EQ -> (c1, Set.union p1 p2)
main = do
(score, visited) <- bestPath . readInput <$> readFile "input16"
print score
print (Set.size visited)
3 points
*
Uiua
Uiua’s new builtin path operator makes this a breeze. Given a function that returns valid neighbours for a point and their relative costs, and another function to test whether you have reached a valid goal, it gives the minimal cost, and all relevant paths. We just need to keep track of the current direction as we work through the maze.
(edit: forgot the Try It Live! link)
Data ← ≡°□°/$"_\n_" "#################\n#...#...#...#..E#\n#.#.#.#.#.#.#.#^#\n#.#.#.#...#...#^#\n#.#.#.#.###.#.#^#\n#>>v#.#.#.....#^#\n#^#v#.#.#.#####^#\n#^#v..#.#.#>>>>^#\n#^#v#####.#^###.#\n#^#v#..>>>>^#...#\n#^#v###^#####.###\n#^#v#>>^#.....#.#\n#^#v#^#####.###.#\n#^#v#^........#.#\n#^#v#^#########.#\n#S#>>^..........#\n#################"
D₄ ← [1_0 ¯1_0 0_1 0_¯1]
End ← ⊢⊚=@EData
Costs ← :∩▽⟜:≡(≠@#⊡:Data⊢).≡⊟⊙⟜(+1×1000¬≡/×=)+⟜:D₄∩¤°⊟
path(Costs|≍End⊙◌°⊟)⊟:1_0⊢⊚=@SData
&p ⧻◴≡⊢/◇⊂ &p :
2 points
3 points
*
C#
Ended up modifying part 1 to do part 2 and return both answers at once.
using System.Collections.Immutable;
using System.Diagnostics;
using Common;
namespace Day16;
static class Program
{
static void Main()
{
var start = Stopwatch.GetTimestamp();
var smallInput = Input.Parse("smallsample.txt");
var sampleInput = Input.Parse("sample.txt");
var programInput = Input.Parse("input.txt");
Console.WriteLine($"Part 1 small: {Solve(smallInput)}");
Console.WriteLine($"Part 1 sample: {Solve(sampleInput)}");
Console.WriteLine($"Part 1 input: {Solve(programInput)}");
Console.WriteLine($"That took about {Stopwatch.GetElapsedTime(start)}");
}
static (int part1, int part2) Solve(Input i)
{
State? endState = null;
Dictionary<(Point, int), int> lowestScores = new();
var queue = new Queue<State>();
queue.Enqueue(new State(i.Start, 1, 0, ImmutableHashSet<Point>.Empty));
while (queue.TryDequeue(out var state))
{
if (ElementAt(i.Map, state.Location) is '#')
{
continue;
}
if (lowestScores.TryGetValue((state.Location, state.DirectionIndex), out var lowestScoreSoFar))
{
if (state.Score > lowestScoreSoFar) continue;
}
lowestScores[(state.Location, state.DirectionIndex)] = state.Score;
var nextStatePoints = state.Points.Add(state.Location);
if (state.Location == i.End)
{
if ((endState is null) || (state.Score < endState.Score))
endState = state with { Points = nextStatePoints };
else if (state.Score == endState.Score)
endState = state with { Points = nextStatePoints.Union(endState.Points) };
continue;
}
// Walk forward
queue.Enqueue(state with
{
Location = state.Location.Move(CardinalDirections[state.DirectionIndex]),
Score = state.Score + 1,
Points = nextStatePoints,
});
// Turn clockwise
queue.Enqueue(state with
{
DirectionIndex = (state.DirectionIndex + 1) % CardinalDirections.Length,
Score = state.Score + 1000,
Points = nextStatePoints,
});
// Turn counter clockwise
queue.Enqueue(state with
{
DirectionIndex = (state.DirectionIndex + CardinalDirections.Length - 1) % CardinalDirections.Length,
Score = state.Score + 1000,
Points = nextStatePoints,
});
}
if (endState is null) throw new Exception("No end state found!");
return (endState.Score, endState.Points.Count);
}
public static void DumpMap(Input i, ISet<Point>? points, Point current)
{
for (int row = 0; row < i.Bounds.Row; row++)
{
for (int col = 0; col < i.Bounds.Col; col++)
{
var p = new Point(row, col);
Console.Write(
(p == current) ? 'X' :
(points?.Contains(p) ?? false) ? 'O' :
ElementAt(i.Map, p));
}
Console.WriteLine();
}
Console.WriteLine();
}
public static char ElementAt(string[] map, Point location) => map[location.Row][location.Col];
public record State(Point Location, int DirectionIndex, int Score, ImmutableHashSet<Point> Points);
public static readonly Direction[] CardinalDirections =
[Direction.Up, Direction.Right, Direction.Down, Direction.Left];
}
public class Input
{
public string[] Map { get; init; } = [];
public Point Start { get; init; } = new(-1, -1);
public Point End { get; init; } = new(-1, -1);
public Point Bounds => new(this.Map.Length, this.Map[0].Length);
public static Input Parse(string file)
{
var map = File.ReadAllLines(file);
Point start = new(-1, -1), end = new(-1, -1);
foreach (var p in map
.SelectMany((line, i) => new []
{
new Point(i, line.IndexOf('S')),
new Point(i, line.IndexOf('E')),
})
.Where(p => p.Col >= 0)
.Take(2))
{
if (map[p.Row][p.Col] is 'S') start = p;
else end = p;
}
return new Input()
{
Map = map,
Start = start,
End = end,
};
}
}
3 points
*
Haskell
This one was surprisingly slow to run
Big codeblock
import Control.Arrow
import Data.Map (Map)
import Data.Set (Set)
import Data.Array.ST (STArray)
import Data.Array (Array)
import Control.Monad.ST (ST, runST)
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Array.ST as MutableArray
import qualified Data.Array as Array
import qualified Data.Maybe as Maybe
data Direction = East | West | South | North
deriving (Show, Eq, Ord)
data MazeTile = Start | End | Wall | Unknown | Explored (Map Direction ExplorationScore)
deriving Eq
-- instance Show MazeTile where
-- show Wall = "#"
-- show Start = "S"
-- show End = "E"
-- show Unknown = "."
-- show (Explored (East, _)) = ">"
-- show (Explored (South, _)) = "v"
-- show (Explored (West, _)) = "<"
-- show (Explored (North, _)) = "^"
type Position = (Int, Int)
type ExplorationScore = Int
translate '#' = Wall
translate '.' = Unknown
translate 'S' = Start
translate 'E' = End
parse :: String -> Array (Int, Int) MazeTile
parse s = Array.listArray ((1, 1), (height - 1, width)) . map translate . filter (/= '\n') $ s
where
width = length . takeWhile (/= '\n') $ s
height = length . filter (== '\n') $ s
(a1, b1) .+. (a2, b2) = (a1+a2, b1+b2)
(a1, b1) .-. (a2, b2) = (a1-a2, b1-b2)
directions = [East, West, South, North]
directionVector East = (0, 1)
directionVector West = (0, -1)
directionVector North = (-1, 0)
directionVector South = ( 1, 0)
turnRight East = South
turnRight South = West
turnRight West = North
turnRight North = East
walkableNeighbors a p = do
let neighbors = List.map ((.+. p) . directionVector) directions
tiles <- mapM (MutableArray.readArray a) neighbors
let neighborPosition = List.map fst . List.filter ((/= Wall). snd) . zip neighbors $ tiles
return $ neighborPosition
findDeadEnds a = Array.assocs
>>> List.filter (snd >>> (== Unknown))
>>> List.map (fst)
>>> List.filter (isDeadEnd a)
$ a
isDeadEnd a p = List.map directionVector
>>> List.map (.+. p)
>>> List.map (a Array.!)
>>> List.filter (/= Wall)
>>> List.length
>>> (== 1)
$ directions
fillDeadEnds :: Array (Int, Int) MazeTile -> ST s (Array (Int, Int) MazeTile)
fillDeadEnds a = do
ma <- MutableArray.thaw a
let deadEnds = findDeadEnds a
mapM_ (fillDeadEnd ma) deadEnds
MutableArray.freeze ma
fillDeadEnd :: STArray s (Int, Int) MazeTile -> Position -> ST s ()
fillDeadEnd a p = do
MutableArray.writeArray a p Wall
p' <- walkableNeighbors a p >>= return . head
t <- MutableArray.readArray a p'
n <- walkableNeighbors a p' >>= return . List.length
if n == 1 && t == Unknown then fillDeadEnd a p' else return ()
thawArray :: Array (Int, Int) MazeTile -> ST s (STArray s (Int, Int) MazeTile)
thawArray a = do
a' <- MutableArray.thaw a
return a'
solveMaze a = do
a' <- fillDeadEnds a
a'' <- thawArray a'
let s = Array.assocs
>>> List.filter ((== Start) . snd)
>>> Maybe.listToMaybe
>>> Maybe.maybe (error "Start not in map") fst
$ a
let e = Array.assocs
>>> List.filter ((== End) . snd)
>>> Maybe.listToMaybe
>>> Maybe.maybe (error "End not in map") fst
$ a
MutableArray.writeArray a'' s $ Explored (Map.singleton East 0)
MutableArray.writeArray a'' e $ Unknown
solveMaze' (s, East) a''
fa <- MutableArray.freeze a''
t <- MutableArray.readArray a'' e
case t of
Wall -> error "Unreachable code"
Start -> error "Unreachable code"
End -> error "Unreachable code"
Unknown -> error "End was not explored yet"
Explored m -> return (List.minimum . List.map snd . Map.toList $ m, countTiles fa s e)
countTiles a s p = Set.size . countTiles' a s p $ South
countTiles' :: Array (Int, Int) MazeTile -> Position -> Position -> Direction -> Set Position
countTiles' a s p d
| p == s = Set.singleton p
| otherwise = Set.unions
. List.map (Set.insert p)
. List.map (uncurry (countTiles' a s))
$ (zip minCostNeighbors minCostDirections)
where
minCostNeighbors = List.map ((p .-.) . directionVector) minCostDirections
minCostDirections = List.map fst . List.filter ((== minCost) . snd) . Map.toList $ visits
visits = case a Array.! p of
Explored m -> Map.adjust (+ (-1000)) d m
minCost = List.minimum . List.map snd . Map.toList $ visits
maybeExplore c p d a = do
t <- MutableArray.readArray a p
case t of
Wall -> return ()
Start -> error "Unreachable code"
End -> error "Unreachable code"
Unknown -> do
MutableArray.writeArray a p $ Explored (Map.singleton d c)
solveMaze' (p, d) a
Explored m -> do
let c' = Maybe.maybe c id (m Map.!? d)
if c <= c' then do
let m' = Map.insert d c m
MutableArray.writeArray a p (Explored m')
solveMaze' (p, d) a
else
return ()
solveMaze' :: (Position, Direction) -> STArray s (Int, Int) MazeTile -> ST s ()
solveMaze' s@(p, d) a = do
t <- MutableArray.readArray a p
case t of
Wall -> return ()
Start -> error "Unreachable code"
End -> error "Unreachable code"
Unknown -> error "Starting on unexplored field"
Explored m -> do
let c = m Map.! d
maybeExplore (c+1) (p .+. directionVector d) d a
let d' = turnRight d
maybeExplore (c+1001) (p .+. directionVector d') d' a
let d'' = turnRight d'
maybeExplore (c+1001) (p .+. directionVector d'') d'' a
let d''' = turnRight d''
maybeExplore (c+1001) (p .+. directionVector d''') d''' a
part1 a = runST (solveMaze a)
main = getContents
>>= print
. part1
. parse
