warrence/AdventOfCode2023
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

281
solvers/ULongWalk.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;