{ 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 . } 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; { 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.