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

AdventOfCode.lpi

@@ -129,6 +129,10 @@
         <Filename Value="solvers\USandSlabs.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="solvers\ULongWalk.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

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;

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 <http://www.gnu.org/licenses/>.
+}
+
+unit ULongWalk;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Generics.Collections, USolver;
+
+type
+  TPoints = specialize TList<TPoint>;
+
+  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<TPath>;
+
+  { TPathStart }
+
+  TPathStart = record
+    Position, ReverseDirection: TPoint;
+    Crossing: TCrossing;
+  end;
+
+  TPathStartQueue = specialize TQueue<TPathStart>;
+
+  { 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<TCrossing>;
+  TCrossingStack = specialize TStack<TCrossing>;
+
+  { 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.
+

tests/AdventOfCodeFPCUnit.lpi

@@ -132,6 +132,10 @@
         <Filename Value="USandSlabsTestCases.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="ULongWalkTestCases.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

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}
 

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 <http://www.gnu.org/licenses/>.
+}
+
+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.
+