From 7b77846abc8c9b44d152bb8287203b31902addbc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sat, 23 Dec 2023 01:30:41 +0100 Subject: [PATCH] Added solution for "Day 22: Sand Slabs", part 1 --- AdventOfCode.lpi | 4 + AdventOfCode.lpr | 3 +- solvers/USandSlabs.pas | 218 ++++++++++++++++++++++++++++++++++ tests/AdventOfCodeFPCUnit.lpi | 4 + tests/AdventOfCodeFPCUnit.lpr | 2 +- tests/USandSlabsTestCases.pas | 78 ++++++++++++ 6 files changed, 307 insertions(+), 2 deletions(-) create mode 100644 solvers/USandSlabs.pas create mode 100644 tests/USandSlabsTestCases.pas diff --git a/AdventOfCode.lpi b/AdventOfCode.lpi index f6ed2ae..685f159 100644 --- a/AdventOfCode.lpi +++ b/AdventOfCode.lpi @@ -125,6 +125,10 @@ + + + + diff --git a/AdventOfCode.lpr b/AdventOfCode.lpr index 039cf72..4f321b0 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; + UPulsePropagation, UStepCounter, USandSlabs; type @@ -90,6 +90,7 @@ begin 19: engine.RunAndFree(TAplenty.Create); 20: engine.RunAndFree(TPulsePropagation.Create); 21: engine.RunAndFree(TStepCounter.Create); + 22: engine.RunAndFree(TSandSlabs.Create); end; engine.Free; diff --git a/solvers/USandSlabs.pas b/solvers/USandSlabs.pas new file mode 100644 index 0000000..959ee03 --- /dev/null +++ b/solvers/USandSlabs.pas @@ -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 . +} + +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) + public + function Compare(constref ALeft, ARight: TBrick): Integer; overload; + end; + + TBricks = specialize TObjectList; + + { 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. + diff --git a/tests/AdventOfCodeFPCUnit.lpi b/tests/AdventOfCodeFPCUnit.lpi index 64daaed..84b736b 100644 --- a/tests/AdventOfCodeFPCUnit.lpi +++ b/tests/AdventOfCodeFPCUnit.lpi @@ -128,6 +128,10 @@ + + + + diff --git a/tests/AdventOfCodeFPCUnit.lpr b/tests/AdventOfCodeFPCUnit.lpr index f7c9310..427b53c 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; + UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases; {$R *.res} diff --git a/tests/USandSlabsTestCases.pas b/tests/USandSlabsTestCases.pas new file mode 100644 index 0000000..d8add09 --- /dev/null +++ b/tests/USandSlabsTestCases.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 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. +