AdventOfCode2023/solvers/UTrebuchet.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 UTrebuchet;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, TypInfo, USolver;

type
  TSpelledOutDigit = (zero, one, two, three, four, five, six, seven, eight, nine);
  TFoundDigitType = (None, Digit, SpelledOutDigit);

  { TTrebuchet }

  TTrebuchet = class(TSolver)
  private
    procedure FindFirstDigit(const ALine: string; out OFirst1, OFirst2, OEndIndex: Integer);
    procedure FindLastDigit(const ALine: string; const AFallbackDigit, AEndIndex: Integer; out OLast1, OLast2: Integer);
    function CheckDigit(const ALine: string; const AIndex: Integer; out ODigit, OEndIndex: Integer): TFoundDigitType;
    function CheckSpelledOutDigit(const ALine: string; const AIndex: Integer; out ODigit, OEndIndex: Integer): Boolean;
  public
    procedure ProcessDataLine(const ALine: string); override;
    procedure Finish; override;
    function GetDataFileName: string; override;
    function GetPuzzleName: string; override;
  end;

implementation

{ TTrebuchet }

procedure TTrebuchet.FindFirstDigit(const ALine: string; out OFirst1, OFirst2, OEndIndex: Integer);
var
  i: Integer;
begin
  OFirst2 := -1;
  for i := 1 to ALine.Length do
    case CheckDigit(ALine, i, OFirst1, OEndIndex) of
      SpelledOutDigit:
        if OFirst2 <= -1 then begin
          OFirst2 := OFirst1;
        end;
      Digit: begin
        if OFirst2 <= -1 then begin
          OFirst2 := OFirst1;
        end;
        Exit;
      end;
    end;
end;

procedure TTrebuchet.FindLastDigit(const ALine: string; const AFallbackDigit, AEndIndex: Integer; out OLast1, OLast2:
  Integer);
var
  i, endIndex: Integer;
begin
  OLast1 := -1;
  OLast2 := -1;
  for i := ALine.Length downto AEndIndex + 1 do
    case CheckDigit(ALine, i, OLast1, endIndex) of
      SpelledOutDigit:
        if OLast2 <= -1 then
          OLast2 := OLast1;
      Digit: begin
        if OLast2 <= -1 then
          OLast2 := OLast1;
        Exit;
      end;
    end;

  if OLast2 <= -1 then
    OLast2 := AFallbackDigit;
  OLast1 := AFallbackDigit;
end;

function TTrebuchet.CheckDigit(const ALine: string; const AIndex: Integer; out ODigit, OEndIndex: Integer):
  TFoundDigitType;
begin
  if ALine[AIndex] in ['0'..'9'] then
  begin
    ODigit := StrToInt(ALine[AIndex]);
    OEndIndex := AIndex;
    Result := Digit;
  end
  else if CheckSpelledOutDigit(ALine, AIndex, ODigit, OEndIndex) then
  begin
    Result := SpelledOutDigit;
  end
  else begin
    ODigit := -1;
    OEndIndex := -1;
    Result := None;
  end;
end;

function TTrebuchet.CheckSpelledOutDigit(const ALine: string; const AIndex: Integer; out ODigit, OEndIndex: Integer):
  Boolean;
var
  i: Integer;
  digitName: string;
begin
  for i := Ord(Low(TSpelledOutDigit)) to Ord(High(TSpelledOutDigit)) do
  begin
    digitName := GetEnumName(TypeInfo(TSpelledOutDigit), Ord(i));
    if CompareStr(digitName, Copy(ALine, AIndex, digitName.Length)) = 0 then
    begin
      ODigit := i;
      OEndIndex := AIndex + digitName.Length - 1;
      Result := True;
      Exit;
    end;
  end;

  ODigit := -1;
  OEndIndex := -1;
  Result := False;
end;

procedure TTrebuchet.ProcessDataLine(const ALine: string);
var
  first1, first2, endIndex, last1, last2: Integer;
begin
  FindFirstDigit(ALine, first1, first2, endIndex);
  FindLastDigit(ALine, first1, endIndex, last1, last2);
  Inc(FPart1, first1 * 10 + last1);
  Inc(FPart2, first2 * 10 + last2);
end;

procedure TTrebuchet.Finish;
begin

end;

function TTrebuchet.GetDataFileName: string;
begin
  Result := 'trebuchet.txt';
end;

function TTrebuchet.GetPuzzleName: string;
begin
  Result := 'Day 1: Trebuchet?!';
end;

end.