Added solution for "Day 22: Sand Slabs", part 1

This commit is contained in:
Stefan Müller 2023-12-23 01:30:41 +01:00 committed by Stefan Müller
parent 197e5f81b9
commit 7b77846abc
6 changed files with 307 additions and 2 deletions

View File

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

View File

@ -27,7 +27,7 @@ uses
UTrebuchet, UCubeConundrum, UGearRatios, UScratchcards, UGiveSeedFertilizer, UWaitForIt, UCamelCards, UTrebuchet, UCubeConundrum, UGearRatios, UScratchcards, UGiveSeedFertilizer, UWaitForIt, UCamelCards,
UHauntedWasteland, UNumberTheory, UMirageMaintenance, UPipeMaze, UCosmicExpansion, UHotSprings, UPointOfIncidence, UHauntedWasteland, UNumberTheory, UMirageMaintenance, UPipeMaze, UCosmicExpansion, UHotSprings, UPointOfIncidence,
UParabolicReflectorDish, ULensLibrary, UFloorWillBeLava, UClumsyCrucible, ULavaductLagoon, UAplenty, UParabolicReflectorDish, ULensLibrary, UFloorWillBeLava, UClumsyCrucible, ULavaductLagoon, UAplenty,
UPulsePropagation, UStepCounter; UPulsePropagation, UStepCounter, USandSlabs;
type type
@ -90,6 +90,7 @@ begin
19: engine.RunAndFree(TAplenty.Create); 19: engine.RunAndFree(TAplenty.Create);
20: engine.RunAndFree(TPulsePropagation.Create); 20: engine.RunAndFree(TPulsePropagation.Create);
21: engine.RunAndFree(TStepCounter.Create); 21: engine.RunAndFree(TStepCounter.Create);
22: engine.RunAndFree(TSandSlabs.Create);
end; end;
engine.Free; engine.Free;

218
solvers/USandSlabs.pas Normal file
View File

@ -0,0 +1,218 @@
{
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 USandSlabs;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Generics.Collections, Generics.Defaults, USolver;
const
CGroundSize = 10;
type
{ TBrick }
TBrick = class
private
FX1, FY1, FZ1, FX2, FY2, FZ2: Integer;
FIsDisintegratable: Boolean;
public
property X1: Integer read FX1;
property Y1: Integer read FY1;
property Z1: Integer read FZ1;
property X2: Integer read FX2;
property Y2: Integer read FY2;
property Z2: Integer read FZ2;
property IsDisintegratable: Boolean read FIsDisintegratable write FIsDisintegratable;
constructor Create(const AX1, AY1, AZ1, AX2, AY2, AZ2: Integer);
constructor Create(const ALine: string);
procedure SetZ1(const AValue: Integer);
end;
{ TBrickComparer }
TBrickComparer = class(TInterfacedObject, specialize IComparer<TBrick>)
public
function Compare(constref ALeft, ARight: TBrick): Integer; overload;
end;
TBricks = specialize TObjectList<TBrick>;
{ TGroundTile }
TGroundTile = record
Height: Integer;
TopBrick: TBrick;
end;
TGround = array[0..CGroundSize - 1, 0.. CGroundSize - 1] of TGroundTile;
{ TSandSlabs }
TSandSlabs = class(TSolver)
private
FBricks: TBricks;
FGround: TGround;
procedure InitGround;
procedure StackBrick(const ABrick: TBrick);
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
{ TBrick }
constructor TBrick.Create(const AX1, AY1, AZ1, AX2, AY2, AZ2: Integer);
begin
FX1 := AX1;
FY1 := AY1;
FZ1 := AZ1;
FX2 := AX2;
FY2 := AY2;
FZ2 := AZ2;
FIsDisintegratable := True;
end;
constructor TBrick.Create(const ALine: string);
var
split: TStringArray;
begin
split := ALine.Split([',', '~']);
Create(StrToInt(split[0]), StrToInt(split[1]), StrToInt(split[2]), StrToInt(split[3]), StrToInt(split[4]),
StrToInt(split[5]));
end;
procedure TBrick.SetZ1(const AValue: Integer);
begin
Inc(FZ2, AValue - FZ1);
FZ1 := AValue;
end;
{ TBrickComparer }
function TBrickComparer.Compare(constref ALeft, ARight: TBrick): Integer;
begin
Result := ALeft.FZ1 - ARight.FZ1;
end;
{ TSandSlabs }
procedure TSandSlabs.InitGround;
var
i, j: Integer;
begin
for i := 0 to CGroundSize - 1 do
for j := 0 to CGroundSize - 1 do
begin
FGround[i, j].Height := 0;
FGround[i, j].TopBrick := nil;
end;
end;
procedure TSandSlabs.StackBrick(const ABrick: TBrick);
var
supports: TBricks;
i, j, max: Integer;
begin
Inc(FPart1);
// Checks height and supports for this brick.
supports := TBricks.Create(False);
max := 0;
for i := ABrick.X1 to ABrick.X2 do
for j := ABrick.Y1 to ABrick.Y2 do
if max <= FGround[i, j].Height then
begin
if max < FGround[i, j].Height then
begin
max := FGround[i, j].Height;
supports.Clear;
end;
if (FGround[i, j].TopBrick <> nil) and not supports.Contains(FGround[i, j].TopBrick) then
supports.Add(FGround[i, j].TopBrick);
end;
// Updates disintegration flag.
if supports.Count = 1 then
begin
if supports[0].IsDisintegratable then
begin
supports[0].IsDisintegratable := False;
Dec(FPart1);
end;
end;
supports.Free;
// Adjusts height and write brick to ground.
ABrick.SetZ1(max + 1);
for i := ABrick.X1 to ABrick.X2 do
for j := ABrick.Y1 to ABrick.Y2 do
begin
FGround[i, j].Height := ABrick.Z2;
FGround[i, j].TopBrick := ABrick;
end;
end;
constructor TSandSlabs.Create;
begin
FBricks := TBricks.Create(TBrickComparer.Create);
end;
destructor TSandSlabs.Destroy;
begin
FBricks.Free;
inherited Destroy;
end;
procedure TSandSlabs.ProcessDataLine(const ALine: string);
begin
FBricks.Add(TBrick.Create(ALine));
end;
procedure TSandSlabs.Finish;
var
brick: TBrick;
begin
FBricks.Sort;
InitGround;
for brick in FBricks do
StackBrick(brick);
end;
function TSandSlabs.GetDataFileName: string;
begin
Result := 'sand_slabs.txt';
end;
function TSandSlabs.GetPuzzleName: string;
begin
Result := 'Day 22: Sand Slabs';
end;
end.

View File

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

View File

@ -8,7 +8,7 @@ uses
UHauntedWastelandTestCases, UMirageMaintenanceTestCases, UPipeMazeTestCases, UCosmicExpansionTestCases, UHauntedWastelandTestCases, UMirageMaintenanceTestCases, UPipeMazeTestCases, UCosmicExpansionTestCases,
UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases, UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases,
UFloorWillBeLavaTestCases, UClumsyCrucibleTestCases, ULavaductLagoonTestCases, UAplentyTestCases, UFloorWillBeLavaTestCases, UClumsyCrucibleTestCases, ULavaductLagoonTestCases, UAplentyTestCases,
UPulsePropagationTestCases, UStepCounterTestCases; UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases;
{$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 USandSlabsTestCases;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry, USolver, UBaseTestCases, USandSlabs;
type
{ TSandSlabsFullDataTestCase }
TSandSlabsFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
{ TSandSlabsExampleTestCase }
TSandSlabsExampleTestCase = class(TExampleEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
implementation
{ TSandSlabsFullDataTestCase }
function TSandSlabsFullDataTestCase.CreateSolver: ISolver;
begin
Result := TSandSlabs.Create;
end;
procedure TSandSlabsFullDataTestCase.TestPart1;
begin
AssertEquals(389, FSolver.GetResultPart1);
end;
{ TSandSlabsExampleTestCase }
function TSandSlabsExampleTestCase.CreateSolver: ISolver;
begin
Result := TSandSlabs.Create;
end;
procedure TSandSlabsExampleTestCase.TestPart1;
begin
AssertEquals(5, FSolver.GetResultPart1);
end;
initialization
RegisterTest(TSandSlabsFullDataTestCase);
RegisterTest(TSandSlabsExampleTestCase);
end.