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. +