Added solution for "Day 23: A Long Walk", part 2

This commit is contained in:
Stefan Müller 2024-09-22 23:54:45 +02:00
parent b5576c66f1
commit e7285e88b5
3 changed files with 275 additions and 22 deletions

View File

@ -184,6 +184,14 @@ For part 1, if a brick lands on a single supporting brick, that brick below cann
For part 2, given a starting brick, the algorithm makes use of the tracked vertical connections to find a group of bricks supported by it, such that all supports of the bricks in the group are also in the group. This group of bricks would fall if the starting brick was disintegrated, so its size is counted for each possible starting brick.
### Day 23: A Long Walk
:mag_right: Puzzle: <https://adventofcode.com/2023/day/23>, :white_check_mark: Solver: [`ULongWalk.pas`](solvers/ULongWalk.pas)
There is a nice *O(|V| * |E|)* algorithm for the maximum flow in a directed acyclic graph, if a topological ordering of the vertices is know. It's relatively easy to parse the edges ("paths") of the long walk from the input such that a topological ordering results, by adding the vertices ("crossings") only after all in-edges have been found.
For part 2, I believe there is no polynomial algorithm known for the general case, and even with the given restraints I was unable to come up with one. Instead, my solution uses a depth-first search to parse all options in the network. This was feasible for the given input with some smart data structures to limit iterations of the vertex or edge lists, and with shortcuts to determine early if a search branch can be abandoned.
### Day 24: Never Tell Me the Odds
:star: :mag_right: Puzzle: <https://adventofcode.com/2023/day/24>, :white_check_mark: Solver: [`UNeverTellMeTheOdds.pas`](solvers/UNeverTellMeTheOdds.pas)

View File

@ -27,16 +27,21 @@ uses
type
TCrossing = class;
TPathSelectionState = (pssNone, pssIncluded, pssExcluded);
{ TPath }
TPath = class
private
FEnd: TCrossing;
FStart, FEnd: TCrossing;
FLength: Integer;
FSelected: TPathSelectionState;
public
property StartCrossing: TCrossing read FStart;
property EndCrossing: TCrossing read FEnd;
property Length: Integer read FLength;
constructor Create(const ALength: Integer; const AEnd: TCrossing);
property Selected: TPathSelectionState read FSelected write FSelected;
constructor Create(const ALength: Integer; const AStart, AEnd: TCrossing);
end;
TPaths = specialize TObjectList<TPath>;
@ -55,20 +60,51 @@ type
TCrossing = class
private
FPosition: TPoint;
FOutPaths: TPaths;
FOutPaths, FPaths: TPaths;
FDistance: Integer;
FNotExcludedDegree: Integer;
public
property Position: TPoint read FPosition;
property OutPaths: TPaths read FOutPaths;
property Paths: TPaths read FPaths;
property Distance: Integer read FDistance write FDistance;
property NotExcludedDegree: Integer read FNotExcludedDegree write FNotExcludedDegree;
function CalcNextPickIndex(const AMinIndex: Integer): Integer;
constructor Create(constref APosition: TPoint);
destructor Destroy; override;
procedure AddOutPath(const AOutPath: TPath);
procedure AddInPath(const AInPath: TPath);
end;
TCrossings = specialize TObjectList<TCrossing>;
TCrossingStack = specialize TStack<TCrossing>;
TPathChoiceResult = (pcrContinue, pcrTargetReached, pcrTargetUnreachable, pcrNoMinimum);
{ TPathChoice }
TPathChoice = class
private
FPrevious: TPathChoice;
FPickIndex: Integer;
FPick: TPath;
FEndCrossing: TCrossing;
FAutoExcludes: TPaths;
FExcludeCost: Int64;
FIncludeCost: Int64;
public
property PickIndex: Integer read FPickIndex;
property EndCrossing: TCrossing read FEndCrossing;
property IncludeCost: Int64 read FIncludeCost;
function Apply(constref ATargetCrossing: TCrossing; const AExcludeCostLimit: Int64): TPathChoiceResult;
procedure Revert;
constructor Create(const AStartCrossing: TCrossing);
constructor Create(const APickIndex: Integer; const APrevious: TPathChoice = nil);
destructor Destroy; override;
end;
TPathChoiceStack = specialize TStack<TPathChoice>;
{ TLongWalk }
TLongWalk = class(TSolver)
@ -76,12 +112,15 @@ type
FLines: TStringList;
FPaths: TPaths;
FCrossings, FWaitingForOtherInPath: TCrossings;
FStart: TCrossing;
FPathLengthSum: Int64;
function GetPosition(constref APoint: TPoint): Char;
procedure ProcessPaths;
procedure StepPath(const AStartPositionQueue: TPathStartQueue);
function FindOrCreateCrossing(constref APosition: TPoint; const AStartPositionQueue: TPathStartQueue): TCrossing;
// Treats the graph as directed for part 1.
procedure FindLongestPath;
// Treats the graph as undirected for part 2.
procedure FindLongestPathIgnoreSlopes;
public
constructor Create;
destructor Destroy; override;
@ -101,30 +140,163 @@ implementation
{ TPath }
constructor TPath.Create(const ALength: Integer; const AEnd: TCrossing);
constructor TPath.Create(const ALength: Integer; const AStart, AEnd: TCrossing);
begin
FLength := ALength;
FStart := AStart;
FEnd := AEnd;
FSelected := pssNone;
end;
{ TCrossing }
function TCrossing.CalcNextPickIndex(const AMinIndex: Integer): Integer;
begin
Result := AMinIndex;
while (Result < FPaths.Count) and (FPaths[Result].Selected <> pssNone) do
Inc(Result);
end;
constructor TCrossing.Create(constref APosition: TPoint);
begin
FPosition := APosition;
FOutPaths := TPaths.Create(False);
FPaths := TPaths.Create(False);
FDistance := 0;
FNotExcludedDegree := 0;
end;
destructor TCrossing.Destroy;
begin
FOutPaths.Free;
FPaths.Free;
inherited Destroy;
end;
procedure TCrossing.AddOutPath(const AOutPath: TPath);
begin
FOutPaths.Add(AOutPath);
FPaths.Add(AOutPath);
Inc(FNotExcludedDegree);
end;
procedure TCrossing.AddInPath(const AInPath: TPath);
begin
FPaths.Add(AInPath);
Inc(FNotExcludedDegree);
end;
{ TPathChoice }
function TPathChoice.Apply(constref ATargetCrossing: TCrossing; const AExcludeCostLimit: Int64): TPathChoiceResult;
var
path: TPath;
excludeStack: TCrossingStack;
crossing, otherCrossing: TCrossing;
begin
Result := pcrContinue;
// Includes the selected path (edge) and checks whether target has been reached.
FPick.Selected := pssIncluded;
if FEndCrossing = ATargetCrossing then
Result := pcrTargetReached
else if FPrevious <> nil then
begin
// If the target has not been reached, starts at the starting crossing (which is the same as FPRevious.EndCrossing)
// and recursively excludes other connected paths (edges).
excludeStack := TCrossingStack.Create;
excludeStack.Push(FPrevious.EndCrossing);
while excludeStack.Count > 0 do
begin
crossing := excludeStack.Pop;
for path in crossing.Paths do
if path.Selected = pssNone then
begin
// Checks whether the path (edge) to the target crossing has been excluded and if so exits. The input data
// should be such that there is only one such path.
// The last crossing is always an end, never a start of a path (edge).
if path.EndCrossing = ATargetCrossing then
begin
Result := pcrTargetUnreachable;
excludeStack.Free;
Exit;
end
else begin
// Excludes the path (edge).
path.Selected := pssExcluded;
crossing.NotExcludedDegree := crossing.NotExcludedDegree - 1;
FAutoExcludes.Add(path);
FExcludeCost := FExcludeCost + path.Length;
// Checks if this choice is worse than the current best.
if FExcludeCost >= AExcludeCostLimit then
begin
Result := pcrNoMinimum;
excludeStack.Free;
Exit;
end;
// Finds the crossing on the other side, updates it, and possibly pushes it for recursion.
if crossing = path.StartCrossing then
otherCrossing := path.EndCrossing
else
otherCrossing := path.StartCrossing;
otherCrossing.NotExcludedDegree := otherCrossing.NotExcludedDegree - 1;
if otherCrossing.NotExcludedDegree < 2 then
excludeStack.Push(otherCrossing);
end;
end;
end;
excludeStack.Free;
end;
end;
procedure TPathChoice.Revert;
var
path: TPath;
begin
FPick.Selected := pssNone;
for path in FAutoExcludes do begin
path.Selected := pssNone;
path.StartCrossing.NotExcludedDegree := path.StartCrossing.NotExcludedDegree + 1;
path.EndCrossing.NotExcludedDegree := path.EndCrossing.NotExcludedDegree + 1;
end;
end;
constructor TPathChoice.Create(const AStartCrossing: TCrossing);
begin
FPrevious := nil;
FPickIndex := 0;
FPick := AStartCrossing.Paths[FPickIndex];
FEndCrossing := FPick.EndCrossing;
FExcludeCost := 0;
FIncludeCost := FPick.FLength;
FAutoExcludes := TPaths.Create(False);
end;
constructor TPathChoice.Create(const APickIndex: Integer; const APrevious: TPathChoice);
begin
FPrevious := APrevious;
FPickIndex := APickIndex;
FPick := FPrevious.EndCrossing.Paths[FPickIndex];
if FPick.StartCrossing = FPrevious.EndCrossing then
FEndCrossing := FPick.EndCrossing
else
FEndCrossing := FPick.StartCrossing;
FExcludeCost := FPrevious.FExcludeCost;
FIncludeCost := FPrevious.FIncludeCost + FPick.FLength;
FAutoExcludes := TPaths.Create(False);
end;
destructor TPathChoice.Destroy;
begin
FAutoExcludes.Free;
inherited Destroy;
end;
{ TLongWalk }
@ -136,17 +308,17 @@ end;
procedure TLongWalk.ProcessPaths;
var
stack: TPathStartQueue;
queue: TPathStartQueue;
pathStart: TPathStart;
begin
stack := TPathStartQueue.Create;
pathStart.Position := FStart.Position;
pathStart.Crossing := FStart;
queue := TPathStartQueue.Create;
pathStart.Crossing := FCrossings.First;
pathStart.Position := FCrossings.First.Position;
pathStart.ReverseDirection := CDirectionUp;
stack.Enqueue(pathStart);
while stack.Count > 0 do
StepPath(stack);
stack.Free;
queue.Enqueue(pathStart);
while queue.Count > 0 do
StepPath(queue);
queue.Free;
end;
procedure TLongWalk.StepPath(const AStartPositionQueue: TPathStartQueue);
@ -161,8 +333,8 @@ var
path: TPath;
begin
start := AStartPositionQueue.Dequeue;
len := 1;
if start.Crossing <> FStart then
len := 0;
if start.Crossing <> FCrossings.First then
Inc(len);
oneMore := False;
stop := False;
@ -190,9 +362,11 @@ begin
until stop;
crossing := FindOrCreateCrossing(start.Position, AStartPositionQueue);
path := TPath.Create(len, crossing);
path := TPath.Create(len, start.Crossing, crossing);
FPathLengthSum := FPathLengthSum + path.FLength;
FPaths.Add(path);
start.Crossing.AddOutPath(path);
crossing.AddInPath(path);
end;
// Crossing with multiple (two) entries will only be added to FCrossings once both in-paths have been processed. This
@ -255,6 +429,8 @@ begin
end
end;
// In a directed graph with a topological ordering on the crossings (vertices), the maximum distance can be computed
// simply by traversing the crossings in that order and calculating the maximum locally.
procedure TLongWalk.FindLongestPath;
var
crossing: TCrossing;
@ -264,17 +440,82 @@ begin
begin
for path in crossing.OutPaths do
if path.EndCrossing.Distance < crossing.Distance + path.Length then
path.EndCrossing.Distance := crossing.Distance + path.Length;
path.EndCrossing.Distance := crossing.Distance + path.Length + 1;
end;
FPart1 := FCrossings.Last.Distance;
end;
// For the undirected graph, we are running a DFS for the second to last crossing (vertex) with backtracking to find the
// minimum of excluded crossings and paths.
procedure TLongWalk.FindLongestPathIgnoreSlopes;
var
pickIndex: Integer;
choice: TPathChoice;
stack: TPathChoiceStack;
minExcludeCost, newExcludeCost: Int64;
begin
minExcludeCost := FPathLengthSum + FCrossings.Count - 1 - FPart1;
// Prepares the first pick, which is the only path connected to the first crossing.
stack := TPathChoiceStack.Create;
choice := TPathChoice.Create(FCrossings.First);
choice.Apply(FCrossings.Last, minExcludeCost);
stack.Push(choice);
// Runs a DFS for last crossing with backtracking, trying to find the minimum cost of excluded paths (i.e. edges).
pickIndex := -1;
while stack.Count > 0 do
begin
// Chooses next path.
pickIndex := stack.Peek.EndCrossing.CalcNextPickIndex(pickIndex + 1);
if pickIndex < stack.Peek.EndCrossing.Paths.Count then
begin
choice := TPathChoice.Create(pickIndex, stack.Peek);
case choice.Apply(FCrossings.Last, minExcludeCost) of
// Continues DFS, target has not yet been reached.
pcrContinue: begin
stack.Push(choice);
pickIndex := -1;
Continue;
end;
// Updates minimum and backtracks last choice, after target has been reached.
pcrTargetReached: begin
// Calculates new exclude cost based on path length sum and the choice's include cost. This effectively
// accounts for the "undecided" paths (edges) as well. Note that this does not actually need the choice's
// exclude costs, these are only required for the early exit in TPathChoice.Apply().
newExcludeCost := FCrossings.Count - stack.Count - 2 + FPathLengthSum - choice.IncludeCost;
if minExcludeCost > newExcludeCost then
minExcludeCost := newExcludeCost;
choice.Revert;
choice.Free;
end;
// Backtracks last choice, after target has been excluded or exclude costs ran over the current best.
pcrTargetUnreachable, pcrNoMinimum: begin
choice.Revert;
choice.Free;
end;
end;
end
else begin
choice := stack.Pop;
pickIndex := choice.PickIndex;
choice.Revert;
choice.Free;
end;
end;
stack.Free;
FPart2 := FPathLengthSum - minExcludeCost + FCrossings.Count - 1;
end;
constructor TLongWalk.Create;
begin
FLines := TStringList.Create;
FPaths := TPaths.Create;
FCrossings := TCrossings.Create;
FWaitingForOtherInPath := TCrossings.Create(False);
FPathLengthSum := 0;
end;
destructor TLongWalk.Destroy;
@ -289,10 +530,7 @@ end;
procedure TLongWalk.ProcessDataLine(const ALine: string);
begin
if FLines.Count = 0 then
begin
FStart := TCrossing.Create(Point(ALine.IndexOf(CPathChar) + 1, 0));
FCrossings.Add(FStart);
end;
FCrossings.Add(TCrossing.Create(Point(ALine.IndexOf(CPathChar) + 1, 0)));
FLines.Add(ALine);
end;
@ -300,6 +538,7 @@ procedure TLongWalk.Finish;
begin
ProcessPaths;
FindLongestPath;
FindLongestPathIgnoreSlopes;
end;
function TLongWalk.GetDataFileName: string;

View File

@ -1,6 +1,6 @@
{
Solutions to the Advent Of Code.
Copyright (C) 2023 Stefan Müller
Copyright (C) 2023-2024 Stefan Müller
This program is free software: you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
@ -33,6 +33,7 @@ type
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
implementation
@ -49,6 +50,11 @@ begin
AssertEquals(94, FSolver.GetResultPart1);
end;
procedure TLongWalkExampleTestCase.TestPart2;
begin
AssertEquals(154, FSolver.GetResultPart2);
end;
initialization
RegisterTest('TLongWalk', TLongWalkExampleTestCase);