Updated day 14 algorithm to not operate directly on the strings

This commit is contained in:
Stefan Müller 2023-12-18 20:30:24 +01:00 committed by Stefan Müller
parent 3501f6f574
commit 515d39da40
1 changed files with 335 additions and 270 deletions

View File

@ -31,48 +31,64 @@ const
CMaxSpinCount = 1000000000;
type
TIntegers = specialize TList<Integer>;
TIntegersList = specialize TObjectList<TIntegers>;
{ TRockPile }
{ TCubeRockInterval }
TRockPile = class
private
FStart, FLength: Integer;
public
constructor Create(const AStart: Integer);
procedure AddRock;
function Any: Boolean;
procedure SetStart(const AStart: Integer);
function CalcWeight(const ALineCount: Integer): Integer;
TCubeRockInterval = record
Start, Stop: Integer;
end;
TRockPiles = specialize TObjectList<TRockPile>;
TCubeRockIntervals = specialize TList<TCubeRockInterval>;
TCubeRockIntervalsList = specialize TObjectList<TCubeRockIntervals>;
{ TRoundRockFormation }
TRoundRockFormation = class
private
FColumns, FRows: TIntegersList;
public
property Columns: TIntegersList read FColumns;
property Rows: TIntegersList read FRows;
constructor Create(const AWidth, AHeight: Integer);
destructor Destroy; override;
procedure AddRock(const AColumn, ARow: Integer);
function CalcWeight: Integer;
function IsEqualTo(const AOther: TRoundRockFormation): Boolean;
function Clone: TRoundRockFormation;
end;
TRoundRockFormations = specialize TObjectList<TRoundRockFormation>;
{ TPlatform }
TPlatform = class
private
FLines: TStringList;
procedure TiltNorth;
procedure TiltSouth;
procedure TiltWest;
procedure TiltEast;
function IsEqualTo(const FOther: TStringList): Boolean;
procedure SwapRockLocation(const AColumn, ARockLineIndex, AEmptyLineIndex: Integer);
FFormation: TRoundRockFormation;
FColumnIntervals, FRowIntervals: TCubeRockIntervalsList;
procedure Tilt(constref AIntervals: TCubeRockIntervalsList; constref ASource, ATarget: TIntegersList;
const AUp: Boolean);
procedure InitIntervals(var AIntervalsList: TCubeRockIntervalsList; const ACount, ALength: Integer);
procedure UpdateIntervals(constref AIntervals: TCubeRockIntervals; const AIndex, AMax: Integer; const ALines:
TStringList; const APreviousCharLineIndex, APreviousCharIndex, ANextCharLineIndex, ANextCharIndex: Integer);
public
constructor Create;
property CurrentFormation: TRoundRockFormation read FFormation;
constructor Create(const ALines: TStringList);
destructor Destroy; override;
procedure Add(const ALine: string);
procedure Spin;
function CalcWeight: Integer;
procedure TiltNorth;
procedure TiltWest;
procedure TiltSouth;
procedure TiltEast;
procedure WriteLnFormation;
procedure WriteLnIntervals;
end;
{ TParabolicReflectorDish }
TParabolicReflectorDish = class(TSolver)
private
FLineIndex: Integer;
FActivePiles, FFinishedPiles: TRockPiles;
FPlatform: TPlatform;
FLines: TStringList;
public
constructor Create;
destructor Destroy; override;
@ -84,205 +100,335 @@ type
implementation
{ TRockPile }
{ TRoundRockFormation }
constructor TRockPile.Create(const AStart: Integer);
begin
FStart := AStart;
FLength := 0;
end;
procedure TRockPile.AddRock;
begin
Inc(FLength);
end;
function TRockPile.Any: Boolean;
begin
Result := (FLength > 0);
end;
procedure TRockPile.SetStart(const AStart: Integer);
begin
FStart := AStart;
end;
function TRockPile.CalcWeight(const ALineCount: Integer): Integer;
begin
Result := FLength * (2 * (ALineCount - FStart) - FLength + 1) div 2;
end;
{ TPlatform }
procedure TPlatform.TiltNorth;
var
i, j, k: Integer;
begin
for i := 0 to FLines.Count - 1 do
for j := 1 to Length(FLines[i]) do
if FLines[i][j] = CRoundRockChar then
begin
k := i - 1;
while (k >= 0) and (FLines[k][j] = CEmptyChar) do
Dec(k);
Inc(k);
if k < i then
SwapRockLocation(j, i, k);
end;
end;
procedure TPlatform.TiltSouth;
var
i, j, k: Integer;
begin
for i := FLines.Count - 1 downto 0 do
for j := 1 to Length(FLines[i]) do
if FLines[i][j] = CRoundRockChar then
begin
k := i + 1;
while (k < FLines.Count) and (FLines[k][j] = CEmptyChar) do
Inc(k);
Dec(k);
if k > i then
SwapRockLocation(j, i, k);
end;
end;
procedure TPlatform.TiltWest;
var
i, j, k: Integer;
s: string;
begin
for i := 0 to FLines.Count - 1 do
begin
s := FLines[i];
k := 1;
for j := 1 to Length(s) do
begin
case s[j] of
CEmptyChar:
if k <= 0 then
k := j;
CRoundRockChar: begin
if (k > 0) and (k < j) then
begin
s[k] := CRoundRockChar;
s[j] := CEmptyChar;
Inc(k);
end
else
k := 0;
end;
CCubeRockChar: k := 0;
end;
end;
FLines[i] := s;
end;
end;
procedure TPlatform.TiltEast;
var
i, j, k: Integer;
s: string;
begin
for i := 0 to FLines.Count - 1 do
begin
s := FLines[i];
k := Length(s) + 1;
for j := Length(s) downto 1 do
begin
case s[j] of
CEmptyChar:
if k > Length(s) then
k := j;
CRoundRockChar: begin
if (k <= Length(s)) and (j < k) then
begin
s[k] := CRoundRockChar;
s[j] := CEmptyChar;
Dec(k);
end
else
k := Length(s) + 1;
end;
CCubeRockChar: k := Length(s) + 1;
end;
end;
FLines[i] := s;
end;
end;
function TPlatform.IsEqualTo(const FOther: TStringList): Boolean;
constructor TRoundRockFormation.Create(const AWidth, AHeight: Integer);
var
i: Integer;
begin
if FLines.Count = FOther.Count then
FColumns := TIntegersList.Create;
FColumns.Count := AWidth;
for i := 0 to FColumns.Count - 1 do
FColumns[i] := TIntegers.Create;
FRows := TIntegersList.Create;
FRows.Count := AHeight;
for i := 0 to FRows.Count - 1 do
FRows[i] := TIntegers.Create;
end;
destructor TRoundRockFormation.Destroy;
begin
FColumns.Free;
FRows.Free;
inherited Destroy;
end;
procedure TRoundRockFormation.AddRock(const AColumn, ARow: Integer);
begin
FColumns[AColumn].Add(ARow);
end;
function TRoundRockFormation.CalcWeight: Integer;
var
i, j: Integer;
begin
Result := 0;
for i := 0 to FColumns.Count - 1 do
for j := 0 to FColumns[i].Count - 1 do
Inc(Result, FRows.Count - FColumns[i][j]);
for i := 0 to FRows.Count - 1 do
Inc(Result, (FRows.Count - i) * FRows[i].Count);
end;
function TRoundRockFormation.IsEqualTo(const AOther: TRoundRockFormation): Boolean;
var
i, j: Integer;
begin
Result := (FColumns.Count = AOther.FColumns.Count) and (FRows.Count = AOther.FRows.Count);
if not Result then
Exit;
for i := 0 to FColumns.Count - 1 do
begin
Result := True;
for i := 0 to FLines.Count - 1 do
if FLines[i] <> FOther[i] then
if FColumns[i].Count <> AOther.FColumns[i].Count then
begin
Result := False;
Exit;
end;
for j := 0 to FColumns[i].Count - 1 do
if FColumns[i][j] <> AOther.FColumns[i][j] then
begin
Result := False;
Exit;
end;
end
else
Result := False;
end;
for i := 0 to FRows.Count - 1 do
begin
if FRows[i].Count <> AOther.FRows[i].Count then
begin
Result := False;
Exit;
end;
for j := 0 to FRows[i].Count - 1 do
if FRows[i][j] <> AOther.FRows[i][j] then
begin
Result := False;
Exit;
end;
end;
end;
procedure TPlatform.SwapRockLocation(const AColumn, ARockLineIndex, AEmptyLineIndex: Integer);
function TRoundRockFormation.Clone: TRoundRockFormation;
var
s: string;
i, rock: Integer;
begin
s := FLines[ARockLineIndex];
s[AColumn] := CEmptyChar;
FLines[ARockLineIndex] := s;
s := FLines[AEmptyLineIndex];
s[AColumn] := CRoundRockChar;
FLines[AEmptyLineIndex] := s;
Result := TRoundRockFormation.Create(FColumns.Count, FRows.Count);
for i := 0 to FColumns.Count - 1 do
for rock in FColumns[i] do
Result.FColumns[i].Add(rock);
for i := 0 to FRows.Count - 1 do
for rock in FRows[i] do
Result.FRows[i].Add(rock);
end;
constructor TPlatform.Create;
{ TPlatform }
procedure TPlatform.Tilt(constref AIntervals: TCubeRockIntervalsList; constref ASource, ATarget:
TIntegersList; const AUp: Boolean);
var
i, rock, nextFree, step: Integer;
interval: TCubeRockInterval;
begin
if AUp then
step := 1
else
step := -1;
for i := 0 to AIntervals.Count - 1 do
begin
for interval in AIntervals[i] do
begin
if AUp then
nextFree := interval.Start
else
nextFree := interval.Stop;
for rock in ASource[i] do
if (interval.Start <= rock) and (rock <= interval.Stop) then
begin
ATarget[nextFree].Add(i);
Inc(nextFree, step);
end;
end;
ASource[i].Clear;
end;
end;
procedure TPlatform.InitIntervals(var AIntervalsList: TCubeRockIntervalsList; const ACount, ALength: Integer);
var
i: Integer;
interval: TCubeRockInterval;
begin
AIntervalsList := TCubeRockIntervalsList.Create;
AIntervalsList.Count := ACount;
interval.Start := 0;
interval.Stop := ALength - 1;
for i := 0 to ACount - 1 do
begin
AIntervalsList[i] := TCubeRockIntervals.Create;
AIntervalsList[i].Add(interval);
end;
end;
procedure TPlatform.UpdateIntervals(constref AIntervals: TCubeRockIntervals; const AIndex, AMax: Integer; const ALines:
TStringList; const APreviousCharLineIndex, APreviousCharIndex, ANextCharLineIndex, ANextCharIndex: Integer);
var
interval: TCubeRockInterval;
begin
if (AIndex > 0) and (ALines[APreviousCharLineIndex][APreviousCharIndex] <> CCubeRockChar) then
begin
// Finishes previous interval.
interval := AIntervals.Last;
interval.Stop := AIndex - 1;
AIntervals[AIntervals.Count - 1] := interval;
end;
if (AIntervals.Count = 1) and (AIntervals[0].Start = AIndex) then
begin
// Shifts first interval if not yet started.
interval := AIntervals[0];
interval.Start := AIndex + 1;
AIntervals[0] := interval;
end
else if (AIndex < AMax) and (ALines[ANextCharLineIndex][ANextCharIndex] <> CCubeRockChar) then
begin
// Starts interval.
interval.Start := AIndex + 1;
interval.Stop := AMax;
AIntervals.Add(interval);
end;
end;
constructor TPlatform.Create(const ALines: TStringList);
var
i, j, width: Integer;
begin
width := Length(ALines[0]);
FFormation := TRoundRockFormation.Create(width, ALines.Count);
InitIntervals(FColumnIntervals, width, ALines.Count);
InitIntervals(FRowIntervals, ALines.Count, width);
for i := 0 to ALines.Count - 1 do
for j := 1 to width do
case ALines[i][j] of
CRoundRockChar: FFormation.AddRock(j - 1, i);
CCubeRockChar: begin
UpdateIntervals(FRowIntervals[i], j - 1, width - 1, ALines, i, j - 1, i, j + 1);
UpdateIntervals(FColumnIntervals[j - 1], i, ALines.Count - 1, ALines, i - 1 , j, i + 1, j);
end;
end;
end;
destructor TPlatform.Destroy;
begin
FFormation.Free;
FColumnIntervals.Free;
FRowIntervals.Free;
inherited Destroy;
end;
procedure TPlatform.TiltNorth;
begin
Tilt(FColumnIntervals, FFormation.Columns, FFormation.Rows, True);
end;
procedure TPlatform.TiltWest;
begin
Tilt(FRowIntervals, FFormation.Rows, FFormation.Columns, True);
end;
procedure TPlatform.TiltSouth;
begin
Tilt(FColumnIntervals, FFormation.Columns, FFormation.Rows, False);
end;
procedure TPlatform.TiltEast;
begin
Tilt(FRowIntervals, FFormation.Rows, FFormation.Columns, False);
end;
procedure TPlatform.WriteLnFormation;
var
i, j: Integer;
begin
WriteLn;
WriteLn('Formation:');
WriteLn(' Columns:');
for i := 0 to FFormation.FColumns.Count - 1 do
begin
Write(' ', i, ': ');
for j := 0 to FFormation.FColumns[i].Count - 1 do
begin
Write(FFormation.FColumns[i][j], ' ');
end;
WriteLn;
end;
WriteLn(' Rows:');
for i := 0 to FFormation.FRows.Count - 1 do
begin
Write(' ', i, ': ');
for j := 0 to FFormation.FRows[i].Count - 1 do
begin
Write(FFormation.FRows[i][j], ' ');
end;
WriteLn;
end;
WriteLn(' Weight: ', FFormation.CalcWeight);
end;
procedure TPlatform.WriteLnIntervals;
var
i, j: Integer;
begin
WriteLn;
WriteLn('Intervals:');
WriteLn(' Columns:');
for i := 0 to FColumnIntervals.Count - 1 do
begin
Write(' ', i, ': ');
for j := 0 to FColumnIntervals[i].Count - 1 do
begin
Write(FColumnIntervals[i][j].Start, '-', FColumnIntervals[i][j].Stop, ' ');
end;
WriteLn;
end;
WriteLn(' Rows:');
for i := 0 to FRowIntervals.Count - 1 do
begin
Write(' ', i, ': ');
for j := 0 to FRowIntervals[i].Count - 1 do
begin
Write(FRowIntervals[i][j].Start, '-', FRowIntervals[i][j].Stop, ' ');
end;
WriteLn;
end;
end;
{ TParabolicReflectorDish }
constructor TParabolicReflectorDish.Create;
begin
FLines := TStringList.Create;
end;
destructor TPlatform.Destroy;
destructor TParabolicReflectorDish.Destroy;
begin
FLines.Free;
inherited Destroy;
end;
procedure TPlatform.Add(const ALine: string);
procedure TParabolicReflectorDish.ProcessDataLine(const ALine: string);
begin
FLines.Add(ALine);
end;
procedure TPlatform.Spin;
procedure TParabolicReflectorDish.Finish;
var
platform: TPlatform;
history: TRoundRockFormations;
i, j, x: Integer;
match: Boolean;
history: specialize TObjectList<TStringList>;
begin
// Intializes history of platform rock configurations.
history := specialize TObjectList<TStringList>.Create;
history.Add(TStringList.Create);
history[0].AddStrings(FLines);
// Initializes platform.
platform := TPlatform.Create(FLines);
// Performs spins until a configuration from the history is encountered again.
// Intializes history of platform rock formation.
history := TRoundRockFormations.Create;
history.Add(platform.CurrentFormation.Clone);
// Performs spins until a rock formation from the history is encountered again.
for i := 1 to CMaxSpinCount do
begin
TiltNorth;
TiltWest;
TiltSouth;
TiltEast;
platform.TiltNorth;
if FPart1 = 0 then
FPart1 := platform.CurrentFormation.CalcWeight;
platform.TiltWest;
platform.TiltSouth;
platform.TiltEast;
// Searches history for the current configuration.
// Searches history for the current rock formation.
j := 0;
match := False;
while (j < history.Count) and not match do
// history.Count - 1 because current rock formation will never be equal to the last one.
while (j < history.Count - 1) and not match do
begin
match := IsEqualTo(history[j]);
match := platform.CurrentFormation.IsEqualTo(history[j]);
if not match then
Inc(j);
end;
@ -292,97 +438,16 @@ begin
x := CMaxSpinCount mod (i - j);
while x < j do
Inc(x, i - j);
FLines.Free;
FLines := history.ExtractIndex(x);
FPart2 := history[x].CalcWeight;
Break;
end
else begin
history.Add(TStringList.Create);
history[i].AddStrings(FLines);
history.Add(platform.CurrentFormation.Clone);
end;
end;
history.Free;
end;
function TPlatform.CalcWeight: Integer;
var
i, j, len, count: Integer;
begin
Result := 0;
len := Length(FLines[0]);
for i := 0 to FLines.Count - 1 do
begin
count := 0;
for j := 1 to len do
if FLines[i][j] = CRoundRockChar then
Inc(count);
Inc(Result, count * (FLines.Count - i));
end;
end;
{ TParabolicReflectorDish }
constructor TParabolicReflectorDish.Create;
begin
FLineIndex := 0;
FActivePiles := TRockPiles.Create;
FFinishedPiles := TRockPiles.Create;
FPlatform := TPlatform.Create;
end;
destructor TParabolicReflectorDish.Destroy;
begin
FActivePiles.Free;
FFinishedPiles.Free;
FPlatform.Free;
inherited Destroy;
end;
procedure TParabolicReflectorDish.ProcessDataLine(const ALine: string);
var
i: Integer;
begin
Inc(FLineIndex);
// Initializes the list of active piles, one per column.
if FActivePiles.Count = 0 then
begin
FActivePiles.Count := Length(ALine);
for i:= 0 to FActivePiles.Count - 1 do
FActivePiles[i] := TRockPile.Create(0);
end;
// Updates the active piles from the current line.
for i := 1 to Length(ALine) do
begin
case ALine[i] of
CRoundRockChar: FActivePiles[i - 1].AddRock;
CCubeRockChar:
if FActivePiles[i - 1].Any then
begin
FFinishedPiles.Add(FActivePiles.ExtractIndex(i - 1));
FActivePiles.Insert(i - 1, TRockPile.Create(FLineIndex));
end
else
FActivePiles[i - 1].SetStart(FLineIndex);
end;
end;
FPlatform.Add(ALine);
end;
procedure TParabolicReflectorDish.Finish;
var
pile: TRockPile;
begin
for pile in FFinishedPiles do
Inc(FPart1, pile.CalcWeight(FLineIndex));
for pile in FActivePiles do
Inc(FPart1, pile.CalcWeight(FLineIndex));
// Spins the platform and weighs the rocks.
FPlatform.Spin;
FPart2 := FPlatform.CalcWeight;
platform.Free;
end;
function TParabolicReflectorDish.GetDataFileName: string;