AdventOfCode2023/solvers/UGearRatios.pas

308 lines
7.8 KiB
Plaintext

{
Solutions to the Advent Of Code.
Copyright (C) 2023 Stefan Müller
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
Foundation, either version 3 of the License, or (at your option) any later
version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with
this program. If not, see <http://www.gnu.org/licenses/>.
}
unit UGearRatios;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Generics.Collections, USolver;
const
CDigitChars = ['0'..'9'];
CNonSymbolChars = ['0'..'9', '.'];
CGearChar = '*';
type
{ TGearCandidate }
TGearCandidate = class
private
FColumn, FPartNumber1, FPartNumber2, FPartNumber3: Integer;
public
constructor Create(AColumn: Integer);
procedure AddPartNumber(APartNumber: Integer);
function GetGearRatio: Integer;
property Column: Integer read FColumn;
end;
{ TGearCandidates }
TGearCandidates = specialize TObjectList<TGearCandidate>;
{ TGearCandidateTracker }
TGearCandidateTracker = class
private
FPreviousLine, FLine, FNextLine, FCurrentNumber: TGearCandidates;
public
constructor Create;
destructor Destroy; override;
function GetLine(AIndex: Integer): TGearCandidates;
function FinishLine: Integer;
property PreviousLine: TGearCandidates read FPreviousLine;
property Line: TGearCandidates read FLine;
property NextLine: TGearCandidates read FNextLine;
property CurrentNumber: TGearCandidates read FCurrentNumber;
end;
{ TGearRatios }
TGearRatios = class(TSolver)
private
FPreviousLine, FLine: string;
FGearTracker: TGearCandidateTracker;
procedure ProcessDataLineTriplet(const APreviousLine, ALine, ANextLine: string);
function HasSymbolCharInColumn(const AIndex: Integer; const ALines: array of string): Boolean;
procedure LogForCurrentGearCandidates(const APartNumber: Integer);
public
constructor Create;
destructor Destroy; override;
procedure ProcessDataLine(const ALine: string); override;
procedure Finish; override;
function GetDataFileName: string; override;
function GetPuzzleName: string; override;
end;
implementation
{ TGearCandidate }
constructor TGearCandidate.Create(AColumn: Integer);
begin
FColumn := AColumn;
FPartNumber1 := 0;
FPartNumber2 := 0;
FPartNumber3 := 0;
end;
procedure TGearCandidate.AddPartNumber(APartNumber: Integer);
begin
if FPartNumber1 = 0 then
FPartNumber1 := APartNumber
else if FPartNumber2 = 0 then
FPartNumber2 := APartNumber
else
FPartNumber3 := APartNumber;
end;
function TGearCandidate.GetGearRatio: Integer;
begin
if FPartNumber3 = 0 then
Result := FPartNumber1 * FPartNumber2
else
Result := 0;
end;
{ TGearCandidateTracker }
constructor TGearCandidateTracker.Create;
begin
FPreviousLine := TGearCandidates.Create;
FLine := TGearCandidates.Create;
FNextLine := TGearCandidates.Create;
FCurrentNumber := TGearCandidates.Create(False);
end;
destructor TGearCandidateTracker.Destroy;
begin
FPreviousLine.Free;
FLine.Free;
FNextLine.Free;
FCurrentNumber.Free;
inherited Destroy;
end;
function TGearCandidateTracker.GetLine(AIndex: Integer): TGearCandidates;
begin
case AIndex of
0: Result := FPreviousLine;
1: Result := FLine;
2: Result := FNextLine;
else Result := nil;
end;
end;
function TGearCandidateTracker.FinishLine: Integer;
var
candidate: TGearCandidate;
temp: TGearCandidates;
begin
Result := 0;
for candidate in FPreviousLine do
begin
Inc(Result, candidate.GetGearRatio);
end;
FPreviousLine.Clear;
temp := FPreviousLine;
FPreviousLine := FLine;
FLine := FNextLine;
FNextLine := temp;
end;
{ TGearRatios }
procedure TGearRatios.ProcessDataLineTriplet(const APreviousLine, ALine, ANextLine: string);
var
i, numberStart, numberLength, partNumber: Integer;
inNumber, isPartNumber: Boolean;
begin
inNumber := False;
for i := 1 to ALine.Length do
begin
// Checks if number starts.
if not inNumber and (ALine[i] in CDigitChars) then
begin
inNumber := True;
numberStart := i;
FGearTracker.CurrentNumber.Clear;
// Checks for a symbol in the column before the first digit.
isPartNumber := (i > 1) and HasSymbolCharInColumn(i - 1, [APreviousLine, ALine, ANextLine]);
end;
// Checks for a symbol in the column of the current digit.
if inNumber and HasSymbolCharInColumn(i, [APreviousLine, ALine, ANextLine]) then
isPartNumber := True;
// Checks if number ends.
if inNumber and (not (ALine[i] in CDigitChars) or (i = ALine.Length)) then
begin
inNumber := False;
// Counts if it is a part number.
if isPartNumber then
begin
numberLength := i - numberStart;
if ALine[i] in CDigitChars then
Inc(numberLength);
partNumber := StrToInt(Copy(ALine, numberStart, numberLength));
Inc(FPart1, partNumber);
LogForCurrentGearCandidates(partNumber);
end;
end;
end;
Inc(FPart2, FGearTracker.FinishLine);
end;
function TGearRatios.HasSymbolCharInColumn(const AIndex: Integer; const ALines: array of string): Boolean;
var
i: Integer;
candidates: TGearCandidates;
candidate: TGearCandidate;
exists: Boolean;
begin
Result := False;
for i := 0 to High(ALines) do
if not (ALines[i][AIndex] in CNonSymbolChars) then
begin
Result := True;
// Could exit here for part 1, the following is only for part 2.
if ALines[i][AIndex] = CGearChar then
begin
candidates := FGearTracker.GetLine(i);
exists := False;
for candidate in candidates do
begin
if candidate.Column = AIndex then
begin
// The current gear candidate has already been found.
FGearTracker.CurrentNumber.Add(candidate);
exists := True;
Break;
end;
end;
if not exists then
begin
// A new gear candidate was found.
candidate := TGearCandidate.Create(AIndex);
candidates.Add(candidate);
FGearTracker.CurrentNumber.Add(candidate);
end;
end;
end;
end;
procedure TGearRatios.LogForCurrentGearCandidates(const APartNumber: Integer);
var
candidate: TGearCandidate;
begin
for candidate in FGearTracker.CurrentNumber do
begin
candidate.AddPartNumber(APartNumber);
end;
end;
constructor TGearRatios.Create;
begin
FGearTracker := TGearCandidateTracker.Create;
end;
destructor TGearRatios.Destroy;
begin
FGearTracker.Free;
inherited Destroy;
end;
procedure TGearRatios.ProcessDataLine(const ALine: string);
begin
if not (FLine = '') then
begin
// Processes lines 2 to n - 1 in calls for lines 3 to n.
ProcessDataLineTriplet(FPreviousLine, FLine, ALine);
FPreviousLine := FLine;
FLine := ALine;
end
else if not (FPreviousLine = '') then
begin
// Processes line 1 in call for line 2.
FLine := ALine;
// Duplicates the first line for the algorithm because it does not influence the result.
ProcessDataLineTriplet(FPreviousLine, FPreviousLine, FLine);
end
else
// Processes nothing in call for line 1.
FPreviousLine := ALine;
end;
procedure TGearRatios.Finish;
begin
// Processes line n.
// Duplicates the last line for the algorithm because it does not influence the result.
if FLine = '' then
FLine := FPreviousLine;
ProcessDataLineTriplet(FPreviousLine, FLine, FLine);
end;
function TGearRatios.GetDataFileName: string;
begin
Result := 'gear_ratios.txt';
end;
function TGearRatios.GetPuzzleName: string;
begin
Result := 'Day 3: Gear Ratios';
end;
end.