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

This commit is contained in:
Stefan Müller 2023-12-23 20:03:05 +01:00 committed by Stefan Müller
parent 7b77846abc
commit 2bb89c952b
2 changed files with 99 additions and 12 deletions

View File

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

View File

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