AdventOfCode2023/solvers/UGearRatios.pas

{
  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, fgl, 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 TFPGObjectList<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.