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

solvers/USandSlabs.pas

@@ -28,6 +28,8 @@ const
   CGroundSize = 10;
 
 type
+  TBrick = class;
+  TBricks = specialize TObjectList<TBrick>;
 
   { TBrick }
 
@@ -35,6 +37,7 @@ type
   private
     FX1, FY1, FZ1, FX2, FY2, FZ2: Integer;
     FIsDisintegratable: Boolean;
+    FSupportBricks, FTopBricks: TBricks;
   public
     property X1: Integer read FX1;
     property Y1: Integer read FY1;
@@ -43,9 +46,13 @@ type
     property Y2: Integer read FY2;
     property Z2: Integer read FZ2;
     property IsDisintegratable: Boolean read FIsDisintegratable write FIsDisintegratable;
+    property SupportBricks: TBricks read FSupportBricks;
     constructor Create(const AX1, AY1, AZ1, AX2, AY2, AZ2: Integer);
     constructor Create(const ALine: string);
+    destructor Destroy; override;
     procedure SetZ1(const AValue: Integer);
+    procedure AddTopBrick(const ABrick: TBrick);
+    function CalcChainCount: Integer;
   end;
 
   { TBrickComparer }
@@ -55,8 +62,6 @@ type
     function Compare(constref ALeft, ARight: TBrick): Integer; overload;
   end;
 
-  TBricks = specialize TObjectList<TBrick>;
-
   { TGroundTile }
 
   TGroundTile = record
@@ -96,6 +101,8 @@ begin
   FY2 := AY2;
   FZ2 := AZ2;
   FIsDisintegratable := True;
+  FSupportBricks := TBricks.Create(False);
+  FTopBricks := TBricks.Create(False);
 end;
 
 constructor TBrick.Create(const ALine: string);
@@ -107,12 +114,79 @@ begin
     StrToInt(split[5]));
 end;
 
+destructor TBrick.Destroy;
+begin
+  FSupportBricks.Free;
+  FTopBricks.Free;
+  inherited Destroy;
+end;
+
 procedure TBrick.SetZ1(const AValue: Integer);
 begin
   Inc(FZ2, AValue - FZ1);
   FZ1 := AValue;
 end;
 
+procedure TBrick.AddTopBrick(const ABrick: TBrick);
+begin
+  FTopBricks.Add(ABrick);
+end;
+
+function TBrick.CalcChainCount: Integer;
+var
+  chainBricks, uncheckedTopBricks: TBricks;
+  support, chain: TBrick;
+  allSupportsInChain, foundInChain: Boolean;
+begin
+  if FIsDisintegratable then
+    Result := 0
+  else begin
+    chainBricks := TBricks.Create(False);
+    uncheckedTopBricks := TBricks.Create(TBrickComparer.Create, False);
+    uncheckedTopBricks.AddRange(FTopBricks);
+    while uncheckedTopBricks.Count > 0 do
+    begin
+      uncheckedTopBricks.Sort;
+
+      foundInChain := False;
+      for chain in chainBricks do
+        if chain = uncheckedTopBricks[0] then
+          foundInChain := True;
+
+      if not foundInChain then
+      begin
+        allSupportsInChain := True;
+        for support in uncheckedTopBricks[0].FSupportBricks do
+          if support <> Self then
+          begin
+            foundInChain := False;
+            for chain in chainBricks do
+              if chain = support then
+              begin
+                foundInChain := True;
+                Break;
+              end;
+            if not foundInChain then
+            begin
+              allSupportsInChain := False;
+              Break;
+            end;
+          end;
+        if allSupportsInChain then
+        begin
+          chainBricks.Add(uncheckedTopBricks[0]);
+          uncheckedTopBricks.AddRange(uncheckedTopBricks[0].FTopBricks);
+        end;
+      end;
+      uncheckedTopBricks.Delete(0);
+    end;
+    uncheckedTopBricks.Free;
+
+    Result := chainBricks.Count;
+    chainBricks.Free;
+  end;
+end;
+
 { TBrickComparer }
 
 function TBrickComparer.Compare(constref ALeft, ARight: TBrick): Integer;
@@ -136,13 +210,11 @@ 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);
+  // Checks height and supportBricks for this brick.
   max := 0;
   for i := ABrick.X1 to ABrick.X2 do
     for j := ABrick.Y1 to ABrick.Y2 do
@@ -151,22 +223,23 @@ begin
         if max < FGround[i, j].Height then
         begin
           max := FGround[i, j].Height;
-          supports.Clear;
+          ABrick.SupportBricks.Clear;
         end;
-        if (FGround[i, j].TopBrick <> nil) and not supports.Contains(FGround[i, j].TopBrick) then
-          supports.Add(FGround[i, j].TopBrick);
+        if (FGround[i, j].TopBrick <> nil) and not ABrick.SupportBricks.Contains(FGround[i, j].TopBrick) then
+          ABrick.SupportBricks.Add(FGround[i, j].TopBrick);
       end;
 
   // Updates disintegration flag.
-  if supports.Count = 1 then
+  if ABrick.SupportBricks.Count = 1 then
   begin
-    if supports[0].IsDisintegratable then
+    if ABrick.SupportBricks[0].IsDisintegratable then
     begin
-      supports[0].IsDisintegratable := False;
+      ABrick.SupportBricks[0].IsDisintegratable := False;
       Dec(FPart1);
     end;
   end;
-  supports.Free;
+  for i := 0 to ABrick.SupportBricks.Count - 1 do
+    ABrick.SupportBricks[i].AddTopBrick(ABrick);
 
   // Adjusts height and write brick to ground.
   ABrick.SetZ1(max + 1);
@@ -202,6 +275,8 @@ begin
   InitGround;
   for brick in FBricks do
     StackBrick(brick);
+  for brick in FBricks do
+    Inc(FPart2, brick.CalcChainCount);
 end;
 
 function TSandSlabs.GetDataFileName: string;

tests/USandSlabsTestCases.pas

@@ -33,6 +33,7 @@ type
     function CreateSolver: ISolver; override;
   published
     procedure TestPart1;
+    procedure TestPart2;
   end;
 
   { TSandSlabsExampleTestCase }
@@ -42,6 +43,7 @@ type
     function CreateSolver: ISolver; override;
   published
     procedure TestPart1;
+    procedure TestPart2;
   end;
 
 implementation
@@ -58,6 +60,11 @@ begin
   AssertEquals(389, FSolver.GetResultPart1);
 end;
 
+procedure TSandSlabsFullDataTestCase.TestPart2;
+begin
+  AssertEquals(70609, FSolver.GetResultPart2);
+end;
+
 { TSandSlabsExampleTestCase }
 
 function TSandSlabsExampleTestCase.CreateSolver: ISolver;
@@ -70,6 +77,11 @@ begin
   AssertEquals(5, FSolver.GetResultPart1);
 end;
 
+procedure TSandSlabsExampleTestCase.TestPart2;
+begin
+  AssertEquals(7, FSolver.GetResultPart2);
+end;
+
 initialization
 
   RegisterTest(TSandSlabsFullDataTestCase);