diff --git a/AdventOfCode.lpi b/AdventOfCode.lpi
index 685f159..4af6b98 100644
--- a/AdventOfCode.lpi
+++ b/AdventOfCode.lpi
@@ -129,6 +129,10 @@
+
+
+
+
diff --git a/AdventOfCode.lpr b/AdventOfCode.lpr
index 4f321b0..072640b 100644
--- a/AdventOfCode.lpr
+++ b/AdventOfCode.lpr
@@ -27,7 +27,7 @@ uses
UTrebuchet, UCubeConundrum, UGearRatios, UScratchcards, UGiveSeedFertilizer, UWaitForIt, UCamelCards,
UHauntedWasteland, UNumberTheory, UMirageMaintenance, UPipeMaze, UCosmicExpansion, UHotSprings, UPointOfIncidence,
UParabolicReflectorDish, ULensLibrary, UFloorWillBeLava, UClumsyCrucible, ULavaductLagoon, UAplenty,
- UPulsePropagation, UStepCounter, USandSlabs;
+ UPulsePropagation, UStepCounter, USandSlabs, ULongWalk;
type
@@ -91,6 +91,7 @@ begin
20: engine.RunAndFree(TPulsePropagation.Create);
21: engine.RunAndFree(TStepCounter.Create);
22: engine.RunAndFree(TSandSlabs.Create);
+ 23: engine.RunAndFree(TLongWalk.Create);
end;
engine.Free;
diff --git a/solvers/ULongWalk.pas b/solvers/ULongWalk.pas
new file mode 100644
index 0000000..49de01a
--- /dev/null
+++ b/solvers/ULongWalk.pas
@@ -0,0 +1,321 @@
+{
+ Solutions to the Advent Of Code.
+ Copyright (C) 2023 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
+ Foundation, either version 3 of the License, or (at your option) any later
+ version.
+
+ This program is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License along with
+ this program. If not, see .
+}
+
+unit ULongWalk;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Generics.Collections, USolver;
+
+type
+ TPoints = specialize TList;
+
+ TCrossing = class;
+
+ { TPath }
+
+ TPath = class
+ private
+ FEnd: TCrossing;
+ FLength: Integer;
+ public
+ property EndCrossing: TCrossing read FEnd;
+ property Length: Integer read FLength;
+ constructor Create(const ALength: Integer; const AEnd: TCrossing);
+ end;
+
+ TPaths = specialize TObjectList;
+
+ { TPathStart }
+
+ TPathStart = record
+ Position, ReverseDirection: TPoint;
+ Crossing: TCrossing;
+ end;
+
+ TPathStartQueue = specialize TQueue;
+
+ { TCrossing }
+
+ TCrossing = class
+ private
+ FPosition: TPoint;
+ FOutPaths: TPaths;
+ FDistance: Integer;
+ public
+ property Position: TPoint read FPosition;
+ property OutPaths: TPaths read FOutPaths;
+ property Distance: Integer read FDistance write FDistance;
+ constructor Create(constref APosition: TPoint);
+ destructor Destroy; override;
+ procedure AddOutPath(const AOutPath: TPath);
+ end;
+
+ TCrossings = specialize TObjectList;
+ TCrossingStack = specialize TStack;
+
+ { TLongWalk }
+
+ TLongWalk = class(TSolver)
+ private
+ FLines: TStringList;
+ FPaths: TPaths;
+ FCrossings, FWaitingForOtherInPath: TCrossings;
+ FStart: TCrossing;
+ function GetPosition(constref APoint: TPoint): Char;
+ procedure ProcessPaths;
+ procedure StepPath(const AStartPositionQueue: TPathStartQueue);
+ function FindOrCreateCrossing(constref APosition: TPoint; const AStartPositionQueue: TPathStartQueue): TCrossing;
+ procedure FindLongestPath;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure ProcessDataLine(const ALine: string); override;
+ procedure Finish; override;
+ function GetDataFileName: string; override;
+ function GetPuzzleName: string; override;
+ end;
+
+ TDirection = (dirRight, dirDown, dirLeft, dirUp);
+
+const
+ CPathChar = '.';
+ CForestChar = '#';
+ CRightSlopeChar = '>';
+ CDownSlopeChar = 'v';
+ CDirections: array[TDirection] of TPoint = ((X: 1; Y: 0), (X: 0; Y: 1), (X: -1; Y: 0), (X: 0; Y: -1));
+ CStartReverseDirection: TPoint = (X: 0; Y: -1);
+
+implementation
+
+{ TPath }
+
+constructor TPath.Create(const ALength: Integer; const AEnd: TCrossing);
+begin
+ FLength := ALength;
+ FEnd := AEnd;
+end;
+
+{ TCrossing }
+
+constructor TCrossing.Create(constref APosition: TPoint);
+begin
+ FPosition := APosition;
+ FOutPaths := TPaths.Create(False);
+ FDistance := 0;
+end;
+
+destructor TCrossing.Destroy;
+begin
+ FOutPaths.Free;
+ inherited Destroy;
+end;
+
+procedure TCrossing.AddOutPath(const AOutPath: TPath);
+begin
+ FOutPaths.Add(AOutPath);
+end;
+
+{ TLongWalk }
+
+function TLongWalk.GetPosition(constref APoint: TPoint): Char;
+begin
+ Result := FLines[APoint.Y][APoint.X];
+end;
+
+procedure TLongWalk.ProcessPaths;
+var
+ stack: TPathStartQueue;
+ pathStart: TPathStart;
+begin
+ stack := TPathStartQueue.Create;
+ pathStart.Position := FStart.Position;
+ pathStart.Crossing := FStart;
+ pathStart.ReverseDirection := CStartReverseDirection;
+ stack.Enqueue(pathStart);
+ while stack.Count > 0 do
+ StepPath(stack);
+ stack.Free;
+end;
+
+procedure TLongWalk.StepPath(const AStartPositionQueue: TPathStartQueue);
+var
+ start: TPathStart;
+ new, direction: TPoint;
+ c: Char;
+ len: Integer;
+ oneMore, stop: Boolean;
+ crossing: TCrossing;
+ path: TPath;
+begin
+ start := AStartPositionQueue.Dequeue;
+ len := 1;
+ if start.Crossing <> FStart then
+ Inc(len);
+ oneMore := False;
+ stop := False;
+ repeat
+ for direction in CDirections do
+ if direction <> start.ReverseDirection then
+ begin
+ new := start.Position + direction;
+ c := GetPosition(new);
+ if c <> CForestChar then
+ begin
+ start.ReverseDirection := Point(-direction.X, -direction.Y);
+ start.Position := new;
+
+ if oneMore or (new.Y = FLines.Count - 1) then
+ stop := True
+ else
+ Inc(len);
+
+ if c <> CPathChar then
+ oneMore := True;
+ Break;
+ end;
+ end;
+ until stop;
+
+ crossing := FindOrCreateCrossing(start.Position, AStartPositionQueue);
+ path := TPath.Create(len, crossing);
+ FPaths.Add(path);
+ start.Crossing.AddOutPath(path);
+end;
+
+// Crossing with multiple (two) entries will only be added to FCrossings once both in-paths have been processed. This
+// guarantees a topological order in the list of crossings, which is required for our longest path algorithm.
+function TLongWalk.FindOrCreateCrossing(constref APosition: TPoint; const AStartPositionQueue: TPathStartQueue):
+ TCrossing;
+var
+ i: Integer;
+ pathStart: TPathStart;
+begin
+ Result := nil;
+
+ // Checks if the crossing has already been encountered.
+ i := 0;
+ while (i < FWaitingForOtherInPath.Count) and (Result = nil) do
+ begin
+ if FWaitingForOtherInPath[i].Position = APosition then
+ begin
+ Result := FWaitingForOtherInPath[i];
+ FCrossings.Add(Result);
+ end
+ else
+ Inc(i);
+ end;
+
+ if Result <> nil then
+ begin
+ FWaitingForOtherInPath.Delete(i);
+ Exit;
+ end;
+
+ // Creates a new crossing.
+ Result := TCrossing.Create(APosition);
+
+ // Checks if the new crossing has multiple entries.
+ if (GetPosition(APosition + CDirections[dirLeft]) = CRightSlopeChar)
+ and (GetPosition(APosition + CDirections[dirUp]) = CDownSlopeChar) then
+ FWaitingForOtherInPath.Add(Result)
+ else
+ FCrossings.Add(Result);
+
+ if APosition.Y < FLines.Count - 1 then
+ begin
+ // Adds the exits of this crossing to the stack as starts for new paths.
+ pathStart.Crossing := Result;
+
+ pathStart.Position := APosition + CDirections[dirRight];
+ if GetPosition(pathStart.Position) = CRightSlopeChar then
+ begin
+ pathStart.ReverseDirection := CDirections[dirLeft];
+ AStartPositionQueue.Enqueue(pathStart);
+ end;
+
+ pathStart.Position := APosition + CDirections[dirDown];
+ if GetPosition(pathStart.Position) = CDownSlopeChar then
+ begin
+ pathStart.ReverseDirection := CDirections[dirUp];
+ AStartPositionQueue.Enqueue(pathStart);
+ end;
+ end
+end;
+
+procedure TLongWalk.FindLongestPath;
+var
+ crossing: TCrossing;
+ path: TPath;
+begin
+ for crossing in FCrossings do
+ begin
+ for path in crossing.OutPaths do
+ if path.EndCrossing.Distance < crossing.Distance + path.Length then
+ path.EndCrossing.Distance := crossing.Distance + path.Length;
+ end;
+ FPart1 := FCrossings.Last.Distance;
+end;
+
+constructor TLongWalk.Create;
+begin
+ FLines := TStringList.Create;
+ FPaths := TPaths.Create;
+ FCrossings := TCrossings.Create;
+ FWaitingForOtherInPath := TCrossings.Create(False);
+end;
+
+destructor TLongWalk.Destroy;
+begin
+ FLines.Free;
+ FPaths.Free;
+ FCrossings.Free;
+ FWaitingForOtherInPath.Free;
+ inherited Destroy;
+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;
+ FLines.Add(ALine);
+end;
+
+procedure TLongWalk.Finish;
+begin
+ ProcessPaths;
+ FindLongestPath;
+end;
+
+function TLongWalk.GetDataFileName: string;
+begin
+ Result := 'long_walk.txt';
+end;
+
+function TLongWalk.GetPuzzleName: string;
+begin
+ Result := 'Day 23: A Long Walk';
+end;
+
+end.
+
diff --git a/tests/AdventOfCodeFPCUnit.lpi b/tests/AdventOfCodeFPCUnit.lpi
index 84b736b..a99d0f1 100644
--- a/tests/AdventOfCodeFPCUnit.lpi
+++ b/tests/AdventOfCodeFPCUnit.lpi
@@ -132,6 +132,10 @@
+
+
+
+
diff --git a/tests/AdventOfCodeFPCUnit.lpr b/tests/AdventOfCodeFPCUnit.lpr
index 427b53c..2c65038 100644
--- a/tests/AdventOfCodeFPCUnit.lpr
+++ b/tests/AdventOfCodeFPCUnit.lpr
@@ -8,7 +8,7 @@ uses
UHauntedWastelandTestCases, UMirageMaintenanceTestCases, UPipeMazeTestCases, UCosmicExpansionTestCases,
UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases,
UFloorWillBeLavaTestCases, UClumsyCrucibleTestCases, ULavaductLagoonTestCases, UAplentyTestCases,
- UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases;
+ UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases, ULongWalkTestCases;
{$R *.res}
diff --git a/tests/ULongWalkTestCases.pas b/tests/ULongWalkTestCases.pas
new file mode 100644
index 0000000..71ebcb0
--- /dev/null
+++ b/tests/ULongWalkTestCases.pas
@@ -0,0 +1,78 @@
+{
+ Solutions to the Advent Of Code.
+ Copyright (C) 2023 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
+ Foundation, either version 3 of the License, or (at your option) any later
+ version.
+
+ This program is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License along with
+ this program. If not, see .
+}
+
+unit ULongWalkTestCases;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, fpcunit, testregistry, USolver, UBaseTestCases, ULongWalk;
+
+type
+
+ { TLongWalkFullDataTestCase }
+
+ TLongWalkFullDataTestCase = class(TEngineBaseTest)
+ protected
+ function CreateSolver: ISolver; override;
+ published
+ procedure TestPart1;
+ end;
+
+ { TLongWalkExampleTestCase }
+
+ TLongWalkExampleTestCase = class(TExampleEngineBaseTest)
+ protected
+ function CreateSolver: ISolver; override;
+ published
+ procedure TestPart1;
+ end;
+
+implementation
+
+{ TLongWalkFullDataTestCase }
+
+function TLongWalkFullDataTestCase.CreateSolver: ISolver;
+begin
+ Result := TLongWalk.Create;
+end;
+
+procedure TLongWalkFullDataTestCase.TestPart1;
+begin
+ AssertEquals(2218, FSolver.GetResultPart1);
+end;
+
+{ TLongWalkExampleTestCase }
+
+function TLongWalkExampleTestCase.CreateSolver: ISolver;
+begin
+ Result := TLongWalk.Create;
+end;
+
+procedure TLongWalkExampleTestCase.TestPart1;
+begin
+ AssertEquals(94, FSolver.GetResultPart1);
+end;
+
+initialization
+
+ RegisterTest(TLongWalkFullDataTestCase);
+ RegisterTest(TLongWalkExampleTestCase);
+end.
+