Added solution for "Day 10: Pipe Maze", part 1

This commit is contained in:
Stefan Müller 2023-12-10 12:23:20 +01:00 committed by Stefan Müller
parent d10ad23a4b
commit ac81b20db5
6 changed files with 439 additions and 2 deletions

View File

@ -73,6 +73,10 @@
<Filename Value="solvers\UMirageMaintenance.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="solvers\UPipeMaze.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>

View File

@ -26,7 +26,7 @@ uses
Classes, SysUtils, CustApp,
USolver,
UTrebuchet, UCubeConundrum, UGearRatios, UScratchcards, UGiveSeedFertilizer, UWaitForIt, UCamelCards,
UHauntedWasteland, UNumberTheory, UMirageMaintenance;
UHauntedWasteland, UNumberTheory, UMirageMaintenance, UPipeMaze;
type
@ -60,6 +60,7 @@ begin
engine.RunAndFree(TCamelCards.Create);
engine.RunAndFree(THauntedWasteland.Create);
engine.RunAndFree(TMirageMaintenance.Create);
engine.RunAndFree(TPipeMaze.Create);
engine.Free;
end;

240
solvers/UPipeMaze.pas Normal file
View File

@ -0,0 +1,240 @@
{
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 UPipeMaze;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, USolver;
const
CStartChar = 'S';
type
TDirection = (drEast, drSouth, drWest, drNorth);
{ TPipeMaze }
TPipeMaze = class(TSolver)
private
FWidth, FHeight: Integer;
FStrings: TStringList;
procedure ParseMaze;
function FindStart: TPoint;
procedure DoFirstStep(var APosition: TPoint; out OStartDirection: TDirection);
procedure DoStep(var APosition: TPoint; var ADirection: TDirection);
public
constructor Create;
destructor Destroy; override;
procedure ProcessDataLine(const ALine: string); override;
procedure Finish; override;
function GetDataFileName: string; override;
function GetPuzzleName: string; override;
end;
implementation
{ TPipeMaze }
procedure TPipeMaze.ParseMaze;
var
start, current: TPoint;
nextDirection: TDirection;
begin
FHeight := FStrings.Count;
FWidth := Length(FStrings[0]);
start := FindStart;
current := start;
DoFirstStep(current, nextDirection);
DoStep(current, nextDirection);
Inc(FPart1);
repeat
DoStep(current, nextDirection);
DoStep(current, nextDirection);
Inc(FPart1);
until current = start;
end;
function TPipeMaze.FindStart: TPoint;
var
i, j: Integer;
foundStart: Boolean;
begin
foundStart := False;
i := 0;
while not foundStart and (i < FStrings.Count) do
begin
j := 1;
while not foundStart and (j <= Length(FStrings[i])) do
begin
if FStrings[i][j] = CStartChar then
begin
foundStart := True;
Result.X := j;
Result.Y := i;
end;
Inc(j);
end;
Inc(i);
end;
end;
procedure TPipeMaze.DoFirstStep(var APosition: TPoint; out OStartDirection: TDirection);
begin
// Checks going East.
if APosition.X < FWidth then
begin
if FStrings[APosition.Y][APosition.X + 1] = '-' then
begin
Inc(APosition.X);
OStartDirection := drEast;
Exit;
end
else if FStrings[APosition.Y][APosition.X + 1] = 'J' then
begin
Inc(APosition.X);
OStartDirection := drNorth;
Exit;
end
else if FStrings[APosition.Y][APosition.X + 1] = '7' then
begin
Inc(APosition.X);
OStartDirection := drSouth;
Exit;
end;
end;
// Checks going South.
if APosition.Y < FHeight - 1 then
begin
if FStrings[APosition.Y + 1][APosition.X] = '|' then
begin
Inc(APosition.Y);
OStartDirection := drSouth;
Exit;
end
else if FStrings[APosition.Y + 1][APosition.X] = 'L' then
begin
Inc(APosition.Y);
OStartDirection := drEast;
Exit;
end
else if FStrings[APosition.Y + 1][APosition.X] = 'J' then
begin
Inc(APosition.Y);
OStartDirection := drWest;
Exit;
end;
end;
// Checks going West.
if APosition.X > 1 then
begin
if FStrings[APosition.Y][APosition.X - 1] = '-' then
begin
Dec(APosition.X);
OStartDirection := drWest;
Exit;
end
else if FStrings[APosition.Y][APosition.X - 1] = 'L' then
begin
Dec(APosition.X);
OStartDirection := drNorth;
Exit;
end
else if FStrings[APosition.Y][APosition.X - 1] = 'F' then
begin
Dec(APosition.X);
OStartDirection := drSouth;
Exit;
end;
end;
end;
procedure TPipeMaze.DoStep(var APosition: TPoint; var ADirection: TDirection);
begin
case ADirection of
drEast: begin
Inc(APosition.X);
case FStrings[APosition.Y][APosition.X] of
'J': ADirection := drNorth;
'7': ADirection := drSouth;
end;
end;
drSouth: begin
Inc(APosition.Y);
case FStrings[APosition.Y][APosition.X] of
'L': ADirection := drEast;
'J': ADirection := drWest;
end;
end;
drWest: begin
Dec(APosition.X);
case FStrings[APosition.Y][APosition.X] of
'L': ADirection := drNorth;
'F': ADirection := drSouth;
end;
end;
drNorth: begin
Dec(APosition.Y);
case FStrings[APosition.Y][APosition.X] of
'7': ADirection := drWest;
'F': ADirection := drEast;
end;
end;
end;
end;
constructor TPipeMaze.Create;
begin
FStrings := TStringList.Create;
end;
destructor TPipeMaze.Destroy;
begin
FStrings.Free;
inherited Destroy;
end;
procedure TPipeMaze.ProcessDataLine(const ALine: string);
begin
FStrings.Add(ALine);
end;
procedure TPipeMaze.Finish;
begin
ParseMaze;
end;
function TPipeMaze.GetDataFileName: string;
begin
Result := 'pipe_maze.txt';
end;
function TPipeMaze.GetPuzzleName: string;
begin
Result := 'Day 10: Pipe Maze';
end;
end.

View File

@ -80,6 +80,10 @@
<Filename Value="UMirageMaintenanceTestCases.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="UPipeMazeTestCases.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>

View File

@ -5,7 +5,7 @@ program AdventOfCodeFPCUnit;
uses
Interfaces, Forms, GuiTestRunner, USolver, UBaseTestCases, UTrebuchetTestCases, UCubeConundrumTestCases,
UGearRatiosTestCases, UScratchcardsTestCases, UGiveSeedFertilizerTestCases, UWaitForItTestCases, UCamelCardsTestCases,
UHauntedWastelandTestCases, UMirageMaintenanceTestCases;
UHauntedWastelandTestCases, UMirageMaintenanceTestCases, UPipeMazeTestCases;
{$R *.res}

View File

@ -0,0 +1,188 @@
{
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 UPipeMazeTestCases;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry, USolver, UBaseTestCases, UPipeMaze;
type
{ TPipeMazeFullDataTestCase }
TPipeMazeFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TPipeMazeExampleTestCase }
TPipeMazeExampleTestCase = class(TExampleEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
{ TExample2PipeMaze }
TExample2PipeMaze = class(TPipeMaze)
function GetDataFileName: string; override;
end;
{ TPipeMazeExample2TestCase }
TPipeMazeExample2TestCase = class(TExampleEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
{ TExample3PipeMaze }
TExample3PipeMaze = class(TPipeMaze)
function GetDataFileName: string; override;
end;
{ TPipeMazeExample3TestCase }
TPipeMazeExample3TestCase = class(TExampleEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
{ TExample4PipeMaze }
TExample4PipeMaze = class(TPipeMaze)
function GetDataFileName: string; override;
end;
{ TPipeMazeExample4TestCase }
TPipeMazeExample4TestCase = class(TExampleEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
implementation
{ TPipeMazeFullDataTestCase }
function TPipeMazeFullDataTestCase.CreateSolver: ISolver;
begin
Result := TPipeMaze.Create;
end;
procedure TPipeMazeFullDataTestCase.TestPart1;
begin
AssertEquals(7097, FSolver.GetResultPart1);
end;
procedure TPipeMazeFullDataTestCase.TestPart2;
begin
AssertEquals(-1, FSolver.GetResultPart2);
end;
{ TPipeMazeExampleTestCase }
function TPipeMazeExampleTestCase.CreateSolver: ISolver;
begin
Result := TPipeMaze.Create;
end;
procedure TPipeMazeExampleTestCase.TestPart1;
begin
AssertEquals(4, FSolver.GetResultPart1);
end;
{ TExample2PipeMaze }
function TExample2PipeMaze.GetDataFileName: string;
begin
Result := 'pipe_maze2.txt';
end;
{ TPipeMazeExample2TestCase }
function TPipeMazeExample2TestCase.CreateSolver: ISolver;
begin
Result := TExample2PipeMaze.Create;
end;
procedure TPipeMazeExample2TestCase.TestPart1;
begin
AssertEquals(4, FSolver.GetResultPart1);
end;
{ TExample3PipeMaze }
function TExample3PipeMaze.GetDataFileName: string;
begin
Result := 'pipe_maze3.txt';
end;
{ TPipeMazeExample3TestCase }
function TPipeMazeExample3TestCase.CreateSolver: ISolver;
begin
Result := TExample3PipeMaze.Create;
end;
procedure TPipeMazeExample3TestCase.TestPart1;
begin
AssertEquals(8, FSolver.GetResultPart1);
end;
{ TExample4PipeMaze }
function TExample4PipeMaze.GetDataFileName: string;
begin
Result := 'pipe_maze4.txt';
end;
{ TPipeMazeExample4TestCase }
function TPipeMazeExample4TestCase.CreateSolver: ISolver;
begin
Result := TExample4PipeMaze.Create;
end;
procedure TPipeMazeExample4TestCase.TestPart1;
begin
AssertEquals(8, FSolver.GetResultPart1);
end;
initialization
RegisterTest(TPipeMazeFullDataTestCase);
RegisterTest(TPipeMazeExampleTestCase);
RegisterTest(TPipeMazeExample2TestCase);
RegisterTest(TPipeMazeExample3TestCase);
RegisterTest(TPipeMazeExample4TestCase);
end.