Added solution for "Day 18: Lavaduct Lagoon", part 2

This commit is contained in:
2024-07-03 20:41:19 +02:00
parent b086038aa5
commit ba4195af82
3 changed files with 173 additions and 138 deletions

View File

@@ -22,32 +22,38 @@ unit ULavaductLagoon;
interface
uses
Classes, SysUtils, Generics.Collections, USolver, UCommon;
Classes, SysUtils, StrUtils, Generics.Collections, Math, USolver;
type
{ TDig }
TDig = record
Direction: TPoint;
Length: Cardinal;
TDig = class
Direction, Length: Integer;
end;
TDigs = specialize TList<TDig>;
TDigs = specialize TObjectList<TDig>;
{ TDigSite }
TDigSite = class
private
FDigs: TDigs;
FArea, FTrench: Int64;
function CheckMergeDigs(const ADigIndex: Integer): Cardinal;
public
procedure AddDig(constref ADig: TDig);
procedure CollapseUTurns;
function CalcFinalArea: Int64;
constructor Create;
destructor Destroy; override;
end;
{ TLavaductLagoon }
TLavaductLagoon = class(TSolver)
FDigs: TDigs;
FCurrentPosiiton: TPoint;
FDigRect: TRect;
FDigSite: array of array of Boolean;
FHigh: TPoint;
function AddDig(const ALine: string): TDig;
procedure UpdateDigRect(constref ADig: TDig);
procedure CalculateDigSite;
function CalculateLagoonSize: Int64;
function CheckPositionUntouched(const AX, AY: Integer; var ACount: Integer): Boolean;
FSite1, FSite2: TDigSite;
procedure AddDig(const ALine: string);
public
constructor Create;
destructor Destroy; override;
@@ -59,154 +65,173 @@ type
implementation
{ TLavaductLagoon }
{ TDigSite }
function TLavaductLagoon.AddDig(const ALine: string): TDig;
var
split: TStringArray;
function TDigSite.CheckMergeDigs(const ADigIndex: Integer): Cardinal;
begin
split := ALine.Split([' ']);
case split[0] of
'R': Result.Direction := CDirectionRight;
'D': Result.Direction := CDirectionDown;
'L': Result.Direction := CDirectionLeft;
'U': Result.Direction := CDirectionUp;
end;
Result.Length := StrToUInt(split[1]);
FDigs.Add(Result);
end;
procedure TLavaductLagoon.UpdateDigRect(constref ADig: TDig);
begin
if ADig.Direction.Y = 0 then
Result := 0;
if (0 <= ADigIndex) and (ADigIndex < FDigs.Count - 1) then
begin
Inc(FCurrentPosiiton.X, ADig.Length * ADig.Direction.X);
if FCurrentPosiiton.X < FDigRect.Left then
FDigRect.Left := FCurrentPosiiton.X;
if FDigRect.Right < FCurrentPosiiton.X then
FDigRect.Right := FCurrentPosiiton.X;
end
else begin
Inc(FCurrentPosiiton.Y, ADig.Length * ADig.Direction.Y);
if FCurrentPosiiton.Y < FDigRect.Top then
FDigRect.Top := FCurrentPosiiton.Y;
if FDigRect.Bottom < FCurrentPosiiton.Y then
FDigRect.Bottom := FCurrentPosiiton.Y;
end;
end;
procedure TLavaductLagoon.CalculateDigSite;
var
i, j: Integer;
dig: TDig;
begin
// Initializes dig site array.
FHigh := FDigRect.BottomRight - FDigRect.TopLeft;
SetLength(FDigSite, FHigh.X + 1, FHigh.Y + 1);
for i := 0 to FHigh.X do
for j := 0 to FHigh.Y do
FDigSite[i, j] := False;
// Initializes start position.
FCurrentPosiiton := Point(-FDigRect.Left, -FDigRect.Top);
FDigSite[FCurrentPosiiton.X, FCurrentPosiiton.Y] := True;
// Applies digs to dig site array.
for dig in FDigs do
for i := 1 to dig.Length do
// Appends two consecutive digs, if they go in the same direction.
if FDigs[ADigIndex].Direction = FDigs[ADigIndex + 1].Direction then
begin
FCurrentPosiiton := FCurrentPosiiton + dig.Direction;
FDigSite[FCurrentPosiiton.X, FCurrentPosiiton.Y] := True;
end;
end;
function TLavaductLagoon.CalculateLagoonSize: Int64;
var
stack: specialize TStack<TPoint>;
exteriors, i: Integer;
position, neighbor: TPoint;
direction: PPoint;
begin
// Counts exterior, untouched positions.
stack := specialize TStack<TPoint>.Create;
exteriors := 0;
// Counts untouched position on the edge of the dig site and their neighbors, and pushes those neighbors on the stack.
// With this we ensure that items on the stack are never on the edge, thus avoiding bounds checks later.
for i := 0 to FHigh.Y do
begin
if CheckPositionUntouched(0, i, exteriors)
and (1 < i) and (i < FHigh.Y)
and CheckPositionUntouched(1, i, exteriors) then
stack.Push(Point(1, i));
if CheckPositionUntouched(FHigh.X, i, exteriors)
and (0 < i) and (i < FHigh.Y - 1)
and CheckPositionUntouched(FHigh.X - 1, i, exteriors) then
stack.Push(Point(FHigh.X - 1, i));
end;
for i := 0 to FHigh.X do
begin
if CheckPositionUntouched(i, 0, exteriors)
and (0 < i) and (i < FHigh.X - 1)
and CheckPositionUntouched(i, 1, exteriors) then
stack.Push(Point(i, 1));
if CheckPositionUntouched(i, FHigh.Y, exteriors)
and (1 < i) and (i < FHigh.X)
and CheckPositionUntouched(i, FHigh.Y - 1, exteriors) then
stack.Push(Point(i, FHigh.Y - 1));
end;
// Counts the remaining exterior area while flood-filling the positions.
while stack.Count > 0 do
begin
position := stack.Pop;
for direction in CPCardinalDirections do
FDigs[ADigIndex].Length := FDigs[ADigIndex].Length + FDigs[ADigIndex + 1].Length;
FDigs.Delete(ADigIndex + 1);
Inc(Result);
end
// Otherwise, checks if the directions are opposite.
else if Abs(FDigs[ADigIndex].Direction - FDigs[ADigIndex + 1].Direction) = 2 then
begin
neighbor := position + direction^;
if CheckPositionUntouched(neighbor.X, neighbor.Y, exteriors) then
stack.Push(neighbor);
// Recurses, if the opposite digs cancel each other out.
if FDigs[ADigIndex].Length = FDigs[ADigIndex + 1].Length then
begin
FDigs.DeleteRange(ADigIndex, 2);
Inc(Result, 2);
Inc(Result, CheckMergeDigs(ADigIndex - 1));
end
else begin
// Otherwise, subtracts the opposite directions.
if FDigs[ADigIndex].Length > FDigs[ADigIndex + 1].Length then
FDigs[ADigIndex].Length := FDigs[ADigIndex].Length - FDigs[ADigIndex + 1].Length
else begin
FDigs[ADigIndex].Length := FDigs[ADigIndex + 1].Length - FDigs[ADigIndex].Length;
FDigs[ADigIndex].Direction := FDigs[ADigIndex + 1].Direction;
end;
FDigs.Delete(ADigIndex + 1);
Inc(Result);
end;
end;
end;
stack.Free;
Result := (FHigh.X + 1) * (FHigh.Y + 1) - exteriors;
end;
function TLavaductLagoon.CheckPositionUntouched(const AX, AY: Integer; var ACount: Integer): Boolean;
procedure TDigSite.AddDig(constref ADig: TDig);
begin
Result := not FDigSite[AX, AY];
if Result then
FDigs.Add(ADig);
Inc(FTrench, ADig.Length);
// The new dig might have to be merged with the preceeding dig.
CheckMergeDigs(FDigs.Count - 2);
end;
procedure TDigSite.CollapseUTurns;
var
i, side, backtrack, shorter: Integer;
begin
// If there is a U-turn, it must involve the last dig, otherwise we would have collapsed it in an earlier call
// already. Therefore we check the last three digs first.
i := FDigs.Count - 3;
while (0 <= i) and (i + 2 < FDigs.Count) do
begin
FDigSite[AX, AY] := True;
Inc(ACount);
// We check if three consecutive digs starting at i form a U-turn. It's enough to check whether the first and the
// third have different directions because they must be parallel.
if FDigs[i].Direction <> FDigs[i + 2].Direction then
begin
// Either right or left U-turns enclose an area inside the trench. We do not need to know which one is which and
// just assume here that the right U-turns enclose an area outside and therefore negate it. If it's the other way
// around, then we can simply negate the end result.
side := FDigs[i + 1].Length;
if (FDigs[i].Direction + 1 = FDigs[i + 1].Direction)
or (FDigs[i + 1].Direction + 1 = FDigs[i + 2].Direction) then
side := -side;
// Updates the shortened dig and collapses the U-turn.
backtrack := 0;
shorter := Min(FDigs[i].Length, FDigs[i + 2].Length);
Inc(FArea, side * shorter);
if FDigs[i + 2].Length = shorter then
begin
FDigs.Delete(i + 2);
Inc(backtrack);
Inc(backtrack, CheckMergeDigs(i + 1));
end
else
Dec(FDigs[i + 2].Length, shorter);
if FDigs[i].Length = shorter then
begin
FDigs.Delete(i);
Inc(backtrack);
Inc(backtrack, CheckMergeDigs(i - 1));
end
else
Dec(FDigs[i].Length, shorter);
Dec(i, backtrack);
end
else
Inc(i);
end;
end;
constructor TLavaductLagoon.Create;
function TDigSite.CalcFinalArea: Int64;
begin
// If the area is negative, then outside and inside have to be "swapped", which Abs() achieves here.
// When collapsing the U-turns, only the area up to the imaginary middle line of the dug trench is considered, so half
// of the full length of the dug trench + 1 has to be added to include the whole trench in the area calculation.
Result := Abs(FArea) + FTrench div 2 + 1;
end;
constructor TDigSite.Create;
begin
FDigs := TDigs.Create;
FCurrentPosiiton := Point(0, 0);
FDigRect := Rect(0, 0, 0, 0);
end;
destructor TLavaductLagoon.Destroy;
destructor TDigSite.Destroy;
begin
FDigs.Free;
inherited Destroy;
end;
procedure TLavaductLagoon.ProcessDataLine(const ALine: string);
{ TLavaductLagoon }
procedure TLavaductLagoon.AddDig(const ALine: string);
var
split: TStringArray;
dig: TDig;
begin
dig := AddDig(ALine);
UpdateDigRect(dig);
dig := TDig.Create;
split := ALine.Split([' ']);
case split[0] of
'R': dig.Direction := 0;
'D': dig.Direction := 1;
'L': dig.Direction := 2;
'U': dig.Direction := 3;
end;
dig.Length := StrToInt(split[1]);
FSite1.AddDig(dig);
dig := TDig.Create;
dig.Direction := StrToInt(split[2][8]);
dig.Length := Hex2Dec(Copy(split[2], 3, 5));
FSite2.AddDig(dig);
end;
constructor TLavaductLagoon.Create;
begin
FSite1 := TDigSite.Create;
FSite2 := TDigSite.Create;
end;
destructor TLavaductLagoon.Destroy;
begin
FSite1.Free;
FSite2.Free;
inherited Destroy;
end;
procedure TLavaductLagoon.ProcessDataLine(const ALine: string);
begin
AddDig(ALine);
FSite1.CollapseUTurns;
FSite2.CollapseUTurns;
end;
procedure TLavaductLagoon.Finish;
begin
CalculateDigSite;
FPart1 := CalculateLagoonSize;
// If the area is negative, then outside and inside have to be "swapped", which Abs() achieves here.
// When collapsing the U-turns, only the area up to the imaginary middle line of the dug trench is considered, so half
// of the full length of the dug trench + 1 has to be added to include the whole trench in the area calculation.
FPart1 := FSite1.CalcFinalArea;
FPart2 := FSite2.CalcFinalArea;
end;
function TLavaductLagoon.GetDataFileName: string;