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

AdventOfCode.lpi

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

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;

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 <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.
+

tests/AdventOfCodeFPCUnit.lpi

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

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}
 

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 <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.
+