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

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