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

This commit is contained in:
Stefan Müller 2023-12-11 15:03:01 +01:00 committed by Stefan Müller
parent ac81b20db5
commit 344be871db
2 changed files with 375 additions and 106 deletions

View File

@ -22,24 +22,52 @@ unit UPipeMaze;
interface
uses
Classes, SysUtils, USolver;
Classes, SysUtils, Generics.Collections, USolver;
const
CStartChar = 'S';
type
TDirection = (drEast, drSouth, drWest, drNorth);
TPointArray = array of TPoint;
{ TStepMapping }
TStepMapping = class
private
FStartDirection, FNewDirection: TPoint;
FMapChar: Char;
FLeftSide, FRightSide: TPointArray;
public
property StartDirection: TPoint read FStartDirection;
property NewDirection: TPoint read FNewDirection;
property LeftSide: TPointArray read FLeftSide;
property RightSide: TPointArray read FRightSide;
constructor Create(const AStartDirection, ANewDirection: TPoint; const AMapChar: Char; const ALeftSide,
ARightSide: TPointArray);
constructor CreateReverse(constref AOriginal: TStepMapping);
function TryStep(const AStartDirection: TPoint; const AMapChar: Char): Boolean;
end;
TStepMappings = specialize TObjectList<TStepMapping>;
{ TPipeMaze }
TPipeMaze = class(TSolver)
private
FWidth, FHeight: Integer;
FStrings: TStringList;
FStepMappings: TStepMappings;
FMap, FEnclosureMap: TStringList;
procedure InitStepMappings;
procedure ParseMaze;
function FindStart: TPoint;
procedure DoFirstStep(var APosition: TPoint; out OStartDirection: TDirection);
procedure DoStep(var APosition: TPoint; var ADirection: TDirection);
procedure DoFirstStep(var APosition: TPoint; out OStartDirection: TPoint);
procedure DoStep(var APosition: TPoint; var ADirection: TPoint);
procedure CountEnclosureInside;
function TryCountEnclosureSide(const AChar: Char; out OCount: Int64): Boolean;
procedure UpdateEnclosureMap(const APosition: TPoint; constref AStepMapping: TStepMapping);
function CheckMapBounds(const APosition: TPoint): Boolean;
function GetMapChar(const APosition: TPoint): Char;
function GetEnclosureMapChar(const APosition: TPoint): Char;
procedure SetEnclosureMapChar(const APosition: TPoint; const AChar: Char);
public
constructor Create;
destructor Destroy; override;
@ -51,15 +79,68 @@ type
implementation
{ TStepMapping }
constructor TStepMapping.Create(const AStartDirection, ANewDirection: TPoint; const AMapChar: Char; const ALeftSide,
ARightSide: TPointArray);
begin
FStartDirection := AStartDirection;
FNewDirection := ANewDirection;
FMapChar := AMapChar;
FLeftSide := ALeftSide;
FRightSide := ARightSide;
end;
constructor TStepMapping.CreateReverse(constref AOriginal: TStepMapping);
begin
FStartDirection := Point(-AOriginal.FNewDirection.X, -AOriginal.FNewDirection.Y);
FNewDirection := Point(-AOriginal.FStartDirection.X, -AOriginal.FStartDirection.Y);
FMapChar := AOriginal.FMapChar;
FLeftSide := AOriginal.FRightSide;
FRightSide := AOriginal.FLeftSide;
end;
function TStepMapping.TryStep(const AStartDirection: TPoint; const AMapChar: Char): Boolean;
begin
Result := (FStartDirection = AStartDirection) and (FMapChar = AMapChar);
end;
{ TPipeMaze }
procedure TPipeMaze.InitStepMappings;
var
i: Integer;
begin
FStepMappings.Add(TStepMapping.Create(Point(0, 1), Point(0, 1), '|',
TPointArray.Create(Point(1, 0)),
TPointArray.Create(Point(-1, 0))));
FStepMappings.Add(TStepMapping.Create(Point(1, 0), Point(1, 0), '-',
TPointArray.Create(Point(0, -1)),
TPointArray.Create(Point(0, 1))));
FStepMappings.Add(TStepMapping.Create(Point(-1, 0), Point(0, -1), 'L',
TPointArray.Create(Point(0, 1), Point(-1, 1), Point(-1, 0)),
[]));
FStepMappings.Add(TStepMapping.Create(Point(0, 1), Point(-1, 0), 'J',
TPointArray.Create(Point(1, 0), Point(1, 1), Point(0, 1)),
[]));
FStepMappings.Add(TStepMapping.Create(Point(1, 0), Point(0, 1), '7',
TPointArray.Create(Point(0, -1), Point(1, -1), Point(1, 0)),
[]));
FStepMappings.Add(TStepMapping.Create(Point(0, -1), Point(1, 0), 'F',
TPointArray.Create(Point(-1, 0), Point(-1, -1), Point(0, -1)),
[]));
// Adds reverse step mappings.
for i := 0 to FStepMappings.Count - 1 do
FStepMappings.Add(TStepMapping.CreateReverse(FStepMappings[i]));
end;
procedure TPipeMaze.ParseMaze;
var
start, current: TPoint;
nextDirection: TDirection;
start, current, nextDirection: TPoint;
begin
FHeight := FStrings.Count;
FWidth := Length(FStrings[0]);
FEnclosureMap := TStringList.Create;
FEnclosureMap.AddStrings(FMap);
start := FindStart;
current := start;
@ -73,6 +154,9 @@ begin
DoStep(current, nextDirection);
Inc(FPart1);
until current = start;
CountEnclosureInside;
FEnclosureMap.Free;
end;
function TPipeMaze.FindStart: TPoint;
@ -82,12 +166,12 @@ var
begin
foundStart := False;
i := 0;
while not foundStart and (i < FStrings.Count) do
while not foundStart and (i < FMap.Count) do
begin
j := 1;
while not foundStart and (j <= Length(FStrings[i])) do
while not foundStart and (j <= Length(FMap[i])) do
begin
if FStrings[i][j] = CStartChar then
if FMap[i][j] = CStartChar then
begin
foundStart := True;
Result.X := j;
@ -99,126 +183,171 @@ begin
end;
end;
procedure TPipeMaze.DoFirstStep(var APosition: TPoint; out OStartDirection: TDirection);
procedure TPipeMaze.DoFirstStep(var APosition: TPoint; out OStartDirection: TPoint);
var
stepMapping: TStepMapping;
step: TPoint;
begin
// Checks going East.
if APosition.X < FWidth then
for stepMapping in FStepMappings do
begin
if FStrings[APosition.Y][APosition.X + 1] = '-' then
step := APosition + stepMapping.StartDirection;
if CheckMapBounds(step) and stepMapping.TryStep(stepMapping.StartDirection, GetMapChar(step)) 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;
UpdateEnclosureMap(APosition, stepMapping);
UpdateEnclosureMap(step, stepMapping);
// 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;
APosition := step;
OStartDirection := stepMapping.NewDirection;
Exit;
end;
end;
end;
procedure TPipeMaze.DoStep(var APosition: TPoint; var ADirection: TDirection);
procedure TPipeMaze.DoStep(var APosition: TPoint; var ADirection: TPoint);
var
stepMapping: TStepMapping;
begin
case ADirection of
drEast: begin
Inc(APosition.X);
case FStrings[APosition.Y][APosition.X] of
'J': ADirection := drNorth;
'7': ADirection := drSouth;
APosition := APosition + ADirection;
for stepMapping in FStepMappings do
begin
if stepMapping.TryStep(ADirection, GetMapChar(APosition)) then
begin
ADirection := stepMapping.NewDirection;
UpdateEnclosureMap(APosition, stepMapping);
Exit;
end;
end;
drSouth: begin
Inc(APosition.Y);
case FStrings[APosition.Y][APosition.X] of
'L': ADirection := drEast;
'J': ADirection := drWest;
end;
procedure TPipeMaze.CountEnclosureInside;
begin
if not TryCountEnclosureSide('l', FPart2) then
TryCountEnclosureSide('r', FPart2);
end;
function TPipeMaze.TryCountEnclosureSide(const AChar: Char; out OCount: Int64): Boolean;
var
directions: TPointArray;
stack: specialize TStack<TPoint>;
i, j: Integer;
position, direction, neighbor: TPoint;
c: Char;
begin
directions := TPointArray.Create(Point(0, -1), Point(-1, 0), Point(0, 1), Point(1, 0));
stack := specialize TStack<TPoint>.Create;
OCount := 0;
Result := True;
for i := 0 to FEnclosureMap.Count - 1 do
begin
for j := 1 to Length(FEnclosureMap[i]) do
begin
position := Point(j, i);
if GetEnclosureMapChar(position) = AChar then
begin
stack.Push(position);
SetEnclosureMapChar(position, '%');
Inc(OCount);
end;
while stack.Count > 0 do
begin
position := stack.Pop;
for direction in directions do
begin
if CheckMapBounds(position + direction) then
begin
// Checks the neighboring position.
neighbor := position + direction;
c := GetEnclosureMapChar(neighbor);
if (c <> '%') and (c <> '#') then
begin
stack.Push(neighbor);
SetEnclosureMapChar(neighbor, '%');
Inc(OCount);
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 else
begin
// Exits after hitting an edge of the map.
Result := False;
stack.Free;
Exit;
end;
end;
end;
end;
end;
stack.Free;
end;
procedure TPipeMaze.UpdateEnclosureMap(const APosition: TPoint; constref AStepMapping: TStepMapping);
var
offset, sidePosition: TPoint;
side: TPointArray;
c: Char;
i: Integer;
begin
SetEnclosureMapChar(APosition, '#');
side := AStepMapping.LeftSide;
c := 'l';
for i := 1 to 2 do
begin
for offset in side do
begin
sidePosition := APosition + offset;
if CheckMapBounds(sidePosition) and (GetEnclosureMapChar(sidePosition) <> '#') then
SetEnclosureMapChar(sidePosition, c);
end;
side := AStepMapping.RightSide;
c := 'r';
end;
end;
function TPipeMaze.CheckMapBounds(const APosition: TPoint): Boolean;
begin
Result := (0 <= APosition.Y) and (APosition.Y < FMap.Count)
and (0 < APosition.X) and (APosition.X <= Length(FMap[0]));
end;
function TPipeMaze.GetMapChar(const APosition: TPoint): Char;
begin
Result := FMap[APosition.Y][APosition.X];
end;
function TPipeMaze.GetEnclosureMapChar(const APosition: TPoint): Char;
begin
Result := FEnclosureMap[APosition.Y][APosition.X];
end;
procedure TPipeMaze.SetEnclosureMapChar(const APosition: TPoint; const AChar: Char);
var
s: string;
begin
s := FEnclosureMap[APosition.Y];
s[APosition.X] := AChar;
FEnclosureMap[APosition.Y] := s;
end;
constructor TPipeMaze.Create;
begin
FStrings := TStringList.Create;
FStepMappings := TStepMappings.Create;
InitStepMappings;
FMap := TStringList.Create;
end;
destructor TPipeMaze.Destroy;
begin
FStrings.Free;
FStepMappings.Free;
FMap.Free;
inherited Destroy;
end;
procedure TPipeMaze.ProcessDataLine(const ALine: string);
begin
FStrings.Add(ALine);
FMap.Add(ALine);
end;
procedure TPipeMaze.Finish;

View File

@ -90,6 +90,66 @@ type
procedure TestPart1;
end;
{ TExample5PipeMaze }
TExample5PipeMaze = class(TPipeMaze)
function GetDataFileName: string; override;
end;
{ TPipeMazeExample5TestCase }
TPipeMazeExample5TestCase = class(TExampleEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart2;
end;
{ TExample6PipeMaze }
TExample6PipeMaze = class(TPipeMaze)
function GetDataFileName: string; override;
end;
{ TPipeMazeExample6TestCase }
TPipeMazeExample6TestCase = class(TExampleEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart2;
end;
{ TExample7PipeMaze }
TExample7PipeMaze = class(TPipeMaze)
function GetDataFileName: string; override;
end;
{ TPipeMazeExample7TestCase }
TPipeMazeExample7TestCase = class(TExampleEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart2;
end;
{ TExample8PipeMaze }
TExample8PipeMaze = class(TPipeMaze)
function GetDataFileName: string; override;
end;
{ TPipeMazeExample8TestCase }
TPipeMazeExample8TestCase = class(TExampleEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart2;
end;
implementation
{ TPipeMazeFullDataTestCase }
@ -106,7 +166,7 @@ end;
procedure TPipeMazeFullDataTestCase.TestPart2;
begin
AssertEquals(-1, FSolver.GetResultPart2);
AssertEquals(355, FSolver.GetResultPart2);
end;
{ TPipeMazeExampleTestCase }
@ -178,6 +238,82 @@ begin
AssertEquals(8, FSolver.GetResultPart1);
end;
{ TExample5PipeMaze }
function TExample5PipeMaze.GetDataFileName: string;
begin
Result := 'pipe_maze5.txt';
end;
{ TPipeMazeExample5TestCase }
function TPipeMazeExample5TestCase.CreateSolver: ISolver;
begin
Result := TExample5PipeMaze.Create;
end;
procedure TPipeMazeExample5TestCase.TestPart2;
begin
AssertEquals(4, FSolver.GetResultPart2);
end;
{ TExample6PipeMaze }
function TExample6PipeMaze.GetDataFileName: string;
begin
Result := 'pipe_maze6.txt';
end;
{ TPipeMazeExample6TestCase }
function TPipeMazeExample6TestCase.CreateSolver: ISolver;
begin
Result := TExample6PipeMaze.Create;
end;
procedure TPipeMazeExample6TestCase.TestPart2;
begin
AssertEquals(4, FSolver.GetResultPart2);
end;
{ TExample7PipeMaze }
function TExample7PipeMaze.GetDataFileName: string;
begin
Result := 'pipe_maze7.txt';
end;
{ TPipeMazeExample7TestCase }
function TPipeMazeExample7TestCase.CreateSolver: ISolver;
begin
Result := TExample7PipeMaze.Create;
end;
procedure TPipeMazeExample7TestCase.TestPart2;
begin
AssertEquals(8, FSolver.GetResultPart2);
end;
{ TExample8PipeMaze }
function TExample8PipeMaze.GetDataFileName: string;
begin
Result := 'pipe_maze8.txt';
end;
{ TPipeMazeExample8TestCase }
function TPipeMazeExample8TestCase.CreateSolver: ISolver;
begin
Result := TExample8PipeMaze.Create;
end;
procedure TPipeMazeExample8TestCase.TestPart2;
begin
AssertEquals(10, FSolver.GetResultPart2);
end;
initialization
RegisterTest(TPipeMazeFullDataTestCase);
@ -185,4 +321,8 @@ initialization
RegisterTest(TPipeMazeExample2TestCase);
RegisterTest(TPipeMazeExample3TestCase);
RegisterTest(TPipeMazeExample4TestCase);
RegisterTest(TPipeMazeExample5TestCase);
RegisterTest(TPipeMazeExample6TestCase);
RegisterTest(TPipeMazeExample7TestCase);
RegisterTest(TPipeMazeExample8TestCase);
end.