Added solution for "Day 16: The Floor Will Be Lava", part 1

This commit is contained in:
Stefan Müller 2023-12-19 13:11:39 +01:00 committed by Stefan Müller
parent 2902689d07
commit 58c677f409
6 changed files with 323 additions and 2 deletions

View File

@ -97,6 +97,10 @@
<Filename Value="solvers\ULensLibrary.pas"/> <Filename Value="solvers\ULensLibrary.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
</Unit> </Unit>
<Unit>
<Filename Value="solvers\UFloorWillBeLava.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

View File

@ -25,7 +25,7 @@ uses
{$ENDIF} {$ENDIF}
Classes, SysUtils, CustApp, USolver, UTrebuchet, UCubeConundrum, UGearRatios, UScratchcards, UGiveSeedFertilizer, Classes, SysUtils, CustApp, USolver, UTrebuchet, UCubeConundrum, UGearRatios, UScratchcards, UGiveSeedFertilizer,
UWaitForIt, UCamelCards, UHauntedWasteland, UNumberTheory, UMirageMaintenance, UPipeMaze, UCosmicExpansion, UWaitForIt, UCamelCards, UHauntedWasteland, UNumberTheory, UMirageMaintenance, UPipeMaze, UCosmicExpansion,
UHotSprings, UPointOfIncidence, UParabolicReflectorDish, ULensLibrary; UHotSprings, UPointOfIncidence, UParabolicReflectorDish, ULensLibrary, UFloorWillBeLava;
type type
@ -65,6 +65,7 @@ begin
engine.RunAndFree(TPointOfIncidence.Create); engine.RunAndFree(TPointOfIncidence.Create);
engine.RunAndFree(TParabolicReflectorDish.Create); engine.RunAndFree(TParabolicReflectorDish.Create);
engine.RunAndFree(TLensLibrary.Create); engine.RunAndFree(TLensLibrary.Create);
engine.RunAndFree(TFloorWillBeLava.Create);
engine.Free; engine.Free;
end; end;

View File

@ -0,0 +1,233 @@
{
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 UFloorWillBeLava;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Generics.Collections, USolver;
const
CNoDirection: TPoint = (X: 0; Y: 0);
CEmptyChar = '.';
type
{ TBeam }
TBeam = record
Position, Direction: TPoint;
end;
const
CStartingBeam: TBeam = (Position: (X: 0; Y: 0); Direction: (X: 1; Y: 0));
type
TEnergyState = (esNone, esWestOrHorizontal, esEastOrVertical, esBoth);
{ TTransition }
TTransition = record
IncomingDirection, OutgoingDirection, SplitDirection: TPoint;
Tile: Char;
EnergyChange: TEnergyState;
end;
const
CTransitions: array of TTransition = (
(IncomingDirection: (X: 1; Y: 0); OutgoingDirection: (X: 0; Y: -1); SplitDirection: (X: 0; Y: 0); Tile: '/';
EnergyChange: esWestOrHorizontal),
(IncomingDirection: (X: 0; Y: 1); OutgoingDirection: (X: -1; Y: 0); SplitDirection: (X: 0; Y: 0); Tile: '/';
EnergyChange: esWestOrHorizontal),
(IncomingDirection: (X: -1; Y: 0); OutgoingDirection: (X: 0; Y: 1); SplitDirection: (X: 0; Y: 0); Tile: '/';
EnergyChange: esEastOrVertical),
(IncomingDirection: (X: 0; Y: -1); OutgoingDirection: (X: 1; Y: 0); SplitDirection: (X: 0; Y: 0); Tile: '/';
EnergyChange: esEastOrVertical),
(IncomingDirection: (X: 1; Y: 0); OutgoingDirection: (X: 0; Y: 1); SplitDirection: (X: 0; Y: 0); Tile: '\';
EnergyChange: esWestOrHorizontal),
(IncomingDirection: (X: 0; Y: 1); OutgoingDirection: (X: 1; Y: 0); SplitDirection: (X: 0; Y: 0); Tile: '\';
EnergyChange: esEastOrVertical),
(IncomingDirection: (X: -1; Y: 0); OutgoingDirection: (X: 0; Y: -1); SplitDirection: (X: 0; Y: 0); Tile: '\';
EnergyChange: esEastOrVertical),
(IncomingDirection: (X: 0; Y: -1); OutgoingDirection: (X: -1; Y: 0); SplitDirection: (X: 0; Y: 0); Tile: '\';
EnergyChange: esWestOrHorizontal),
(IncomingDirection: (X: 1; Y: 0); OutgoingDirection: (X: 0; Y: -1); SplitDirection: (X: 0; Y: 1); Tile: '|';
EnergyChange: esBoth),
(IncomingDirection: (X: -1; Y: 0); OutgoingDirection: (X: 0; Y: -1); SplitDirection: (X: 0; Y: 1); Tile: '|';
EnergyChange: esBoth),
(IncomingDirection: (X: 0; Y: 1); OutgoingDirection: (X: -1; Y: 0); SplitDirection: (X: 1; Y: 0); Tile: '-';
EnergyChange: esBoth),
(IncomingDirection: (X: 0; Y: -1); OutgoingDirection: (X: -1; Y: 0); SplitDirection: (X: 1; Y: 0); Tile: '-';
EnergyChange: esBoth)
);
type
{ TFloorWillBeLava }
TFloorWillBeLava = class(TSolver)
private
FLines: TStringList;
function IsBeamOutOfBounds(constref ABeam: TBeam; const AWidth, AHeight: Integer): Boolean;
function GetTile(constref APosition: TPoint): Char;
function GetNewBeam(constref APosition, ADirection: TPoint): TBeam;
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
{ TFloorWillBeLava }
function TFloorWillBeLava.IsBeamOutOfBounds(constref ABeam: TBeam; const AWidth, AHeight: Integer): Boolean;
begin
Result := (ABeam.Position.X < 0) or (ABeam.Position.X >= AWidth)
or (ABeam.Position.Y < 0) or (ABeam.Position.Y >= AHeight);
end;
function TFloorWillBeLava.GetTile(constref APosition: TPoint): Char;
begin
Result := FLines[APosition.Y][APosition.X + 1];
end;
function TFloorWillBeLava.GetNewBeam(constref APosition, ADirection: TPoint): TBeam;
begin
Result.Position := APosition;
Result.Direction := ADirection;
end;
constructor TFloorWillBeLava.Create;
begin
FLines := TStringList.Create;
end;
destructor TFloorWillBeLava.Destroy;
begin
FLines.Free;
inherited Destroy;
end;
procedure TFloorWillBeLava.ProcessDataLine(const ALine: string);
begin
FLines.Add(ALine);
end;
procedure TFloorWillBeLava.Finish;
var
energyMap: array of array of TEnergyState;
width, height, i, j: Integer;
done: Boolean;
stack: specialize TStack<TBeam>;
beam: TBeam;
transition: TTransition;
energyChange: TEnergyState;
s: string;
begin
// Initializes energy map.
width := Length(FLines[0]);
height := FLines.Count;
SetLength(energyMap, width, height);
for i := 0 to width - 1 do
for j := 0 to height - 1 do
energyMap[i, j] := esNone;
// Starts beam.
done := False;
beam := CStartingBeam;
stack := specialize TStack<TBeam>.Create;
repeat
// Processes the current beam.
if IsBeamOutOfBounds(beam, width, height) then
done := True
else begin
if beam.Direction.X <> 0 then
energyChange := esWestOrHorizontal
else
energyChange := esEastOrVertical;
if GetTile(beam.Position) <> CEmptyChar then
begin
// Checks the current position for direction changes and splits.
for transition in CTransitions do
if (transition.IncomingDirection = beam.Direction) and (transition.Tile = GetTile(beam.Position)) then
begin
if transition.SplitDirection <> CNoDirection then
stack.Push(GetNewBeam(beam.Position + transition.SplitDirection, transition.SplitDirection));
beam.Direction := transition.OutgoingDirection;
energyChange := transition.EnergyChange;
Break;
end;
end;
// Energizes the current position.
case energyMap[beam.Position.X, beam.Position.Y] of
esNone: energyMap[beam.Position.X, beam.Position.Y] := energyChange;
esWestOrHorizontal:
if energyChange = esEastOrVertical then
energyMap[beam.Position.X, beam.Position.Y] := esBoth
else
done := True;
esEastOrVertical:
if energyChange = esWestOrHorizontal then
energyMap[beam.Position.X, beam.Position.Y] := esBoth
else
done := True;
esBoth: done := True;
end;
// Moves the beam.
beam.Position := beam.Position + beam.Direction;
end;
if done and (stack.Count > 0) then
begin
// Starts the next beam that was split earlier.
done := False;
beam := stack.Pop;
end;
until done;
stack.Free;
// Counts energized tiles.
for i := 0 to width - 1 do
for j := 0 to height - 1 do
if energyMap[i, j] <> esNone then
Inc(FPart1);
end;
function TFloorWillBeLava.GetDataFileName: string;
begin
Result := 'floor_will_be_lava.txt';
end;
function TFloorWillBeLava.GetPuzzleName: string;
begin
Result := 'Day 16: The Floor Will Be Lava';
end;
end.

View File

@ -104,6 +104,10 @@
<Filename Value="ULensLibraryTestCases.pas"/> <Filename Value="ULensLibraryTestCases.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
</Unit> </Unit>
<Unit>
<Filename Value="UFloorWillBeLavaTestCases.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

View File

@ -6,7 +6,8 @@ uses
Interfaces, Forms, GuiTestRunner, USolver, UBaseTestCases, UTrebuchetTestCases, UCubeConundrumTestCases, Interfaces, Forms, GuiTestRunner, USolver, UBaseTestCases, UTrebuchetTestCases, UCubeConundrumTestCases,
UGearRatiosTestCases, UScratchcardsTestCases, UGiveSeedFertilizerTestCases, UWaitForItTestCases, UCamelCardsTestCases, UGearRatiosTestCases, UScratchcardsTestCases, UGiveSeedFertilizerTestCases, UWaitForItTestCases, UCamelCardsTestCases,
UHauntedWastelandTestCases, UMirageMaintenanceTestCases, UPipeMazeTestCases, UCosmicExpansionTestCases, UHauntedWastelandTestCases, UMirageMaintenanceTestCases, UPipeMazeTestCases, UCosmicExpansionTestCases,
UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases; UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases,
UFloorWillBeLavaTestCases;
{$R *.res} {$R *.res}

View File

@ -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 UFloorWillBeLavaTestCases;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry, USolver, UBaseTestCases, UFloorWillBeLava;
type
{ TFloorWillBeLavaFullDataTestCase }
TFloorWillBeLavaFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
{ TFloorWillBeLavaExampleTestCase }
TFloorWillBeLavaExampleTestCase = class(TExampleEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
implementation
{ TFloorWillBeLavaFullDataTestCase }
function TFloorWillBeLavaFullDataTestCase.CreateSolver: ISolver;
begin
Result := TFloorWillBeLava.Create;
end;
procedure TFloorWillBeLavaFullDataTestCase.TestPart1;
begin
AssertEquals(7392, FSolver.GetResultPart1);
end;
{ TFloorWillBeLavaExampleTestCase }
function TFloorWillBeLavaExampleTestCase.CreateSolver: ISolver;
begin
Result := TFloorWillBeLava.Create;
end;
procedure TFloorWillBeLavaExampleTestCase.TestPart1;
begin
AssertEquals(46, FSolver.GetResultPart1);
end;
initialization
RegisterTest(TFloorWillBeLavaFullDataTestCase);
RegisterTest(TFloorWillBeLavaExampleTestCase);
end.