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

This commit is contained in:
Stefan Müller 2024-06-29 01:03:16 +02:00
parent 4cd9392bbc
commit b086038aa5
2 changed files with 169 additions and 10 deletions

View File

@ -1,6 +1,6 @@
{ {
Solutions to the Advent Of Code. Solutions to the Advent Of Code.
Copyright (C) 2023 Stefan Müller Copyright (C) 2024 Stefan Müller
This program is free software: you can redistribute it and/or modify it under 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 the terms of the GNU General Public License as published by the Free Software
@ -22,14 +22,35 @@ unit ULavaductLagoon;
interface interface
uses uses
Classes, SysUtils, USolver; Classes, SysUtils, Generics.Collections, USolver, UCommon;
type type
{ TDig }
TDig = record
Direction: TPoint;
Length: Cardinal;
end;
TDigs = specialize TList<TDig>;
{ TLavaductLagoon } { TLavaductLagoon }
TLavaductLagoon = class(TSolver) 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;
public public
constructor Create;
destructor Destroy; override;
procedure ProcessDataLine(const ALine: string); override; procedure ProcessDataLine(const ALine: string); override;
procedure Finish; override; procedure Finish; override;
function GetDataFileName: string; override; function GetDataFileName: string; override;
@ -40,14 +61,152 @@ implementation
{ TLavaductLagoon } { TLavaductLagoon }
procedure TLavaductLagoon.ProcessDataLine(const ALine: string); function TLavaductLagoon.AddDig(const ALine: string): TDig;
var
split: TStringArray;
begin 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
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
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
begin
neighbor := position + direction^;
if CheckPositionUntouched(neighbor.X, neighbor.Y, exteriors) then
stack.Push(neighbor);
end;
end;
stack.Free;
Result := (FHigh.X + 1) * (FHigh.Y + 1) - exteriors;
end;
function TLavaductLagoon.CheckPositionUntouched(const AX, AY: Integer; var ACount: Integer): Boolean;
begin
Result := not FDigSite[AX, AY];
if Result then
begin
FDigSite[AX, AY] := True;
Inc(ACount);
end;
end;
constructor TLavaductLagoon.Create;
begin
FDigs := TDigs.Create;
FCurrentPosiiton := Point(0, 0);
FDigRect := Rect(0, 0, 0, 0);
end;
destructor TLavaductLagoon.Destroy;
begin
FDigs.Free;
inherited Destroy;
end;
procedure TLavaductLagoon.ProcessDataLine(const ALine: string);
var
dig: TDig;
begin
dig := AddDig(ALine);
UpdateDigRect(dig);
end; end;
procedure TLavaductLagoon.Finish; procedure TLavaductLagoon.Finish;
begin begin
CalculateDigSite;
FPart1 := CalculateLagoonSize;
end; end;
function TLavaductLagoon.GetDataFileName: string; function TLavaductLagoon.GetDataFileName: string;

View File

@ -33,7 +33,7 @@ type
function CreateSolver: ISolver; override; function CreateSolver: ISolver; override;
published published
procedure TestPart1; procedure TestPart1;
procedure TestPart2; //procedure TestPart2;
end; end;
implementation implementation
@ -50,13 +50,13 @@ begin
AssertEquals(62, FSolver.GetResultPart1); AssertEquals(62, FSolver.GetResultPart1);
end; end;
procedure TLavaductLagoonExampleTestCase.TestPart2; //procedure TLavaductLagoonExampleTestCase.TestPart2;
begin //begin
AssertEquals(-1, FSolver.GetResultPart2); // AssertEquals(-1, FSolver.GetResultPart2);
end; //end;
initialization initialization
//RegisterTest('TLavaductLagoon', TLavaductLagoonExampleTestCase); RegisterTest('TLavaductLagoon', TLavaductLagoonExampleTestCase);
end. end.