AdventOfCode2023/solvers/UStepCounter.pas

{
  Solutions to the Advent Of Code.
  Copyright (C) 2023-2024  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 UStepCounter;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, USolver, UCommon;

type

  { TStepCounter }

  TStepCounter = class(TSolver)
  private
    FLines: TStringList;
    FWidth, FHeight, FMaxSteps1, FMaxSteps2: Integer;
    function FindStart: TPoint;
    function IsInBounds(constref APoint: TPoint): Boolean;
    function GetPosition(constref APoint: TPoint): Char;
    procedure SetPosition(constref APoint: TPoint; const AValue: Char);
    procedure PrepareMap;
    function DoSteps(const AMaxSteps: Integer): Int64;
    function CalcTargetPlotsOnInfiniteMap(const AMaxSteps: Integer): Int64;
  public
    constructor Create(const AMaxStepsPart1: Integer = 64; const AMaxStepsPart2: Integer = 26501365);
    destructor Destroy; override;
    procedure ProcessDataLine(const ALine: string); override;
    procedure Finish; override;
    function GetDataFileName: string; override;
    function GetPuzzleName: string; override;
  end;

const
  CStartChar = 'S';
  CPlotChar = '.';
  CRockChar = '#';
  CTraversedChar = '+';

implementation

{ TStepCounter }

function TStepCounter.FindStart: TPoint;
var
  i, j: Integer;
begin
  for i := 1 to FWidth do
    for j := 0 to FHeight - 1 do
      if FLines[j][i] = CStartChar then
      begin
        Result.X := i;
        Result.Y := j;
        Exit;
      end;
end;

function TStepCounter.IsInBounds(constref APoint: TPoint): Boolean;
begin
  Result := (0 < APoint.X) and (APoint.X <= FWidth) and (0 <= APoint.Y) and (APoint.Y < FHeight);
end;

function TStepCounter.GetPosition(constref APoint: TPoint): Char;
begin
  Result := FLines[APoint.Y][APoint.X];
end;

procedure TStepCounter.SetPosition(constref APoint: TPoint; const AValue: Char);
var
  s: string;
begin
  s := FLines[APoint.Y];
  s[APoint.X] := AValue;
  FLines[APoint.Y] := s;
end;

procedure TStepCounter.PrepareMap;
var
  i, j: Integer;
begin
  for i := 2 to FWidth - 1 do
    for j := 1 to FHeight - 2 do
      if (FLines[j][i] <> CRockChar) and (FLines[j - 1][i] = CRockChar) and (FLines[j + 1][i] = CRockChar)
      and (FLines[j][i - 1] = CRockChar) and (FLines[j][i + 1] = CRockChar) then
        SetPosition(Point(i, j), CRockChar);
end;

function TStepCounter.DoSteps(const AMaxSteps: Integer): Int64;
var
  mod2, currentStep: Integer;
  currentPlots, nextPlots, temp: TPoints;
  plot, next: TPoint;
  pdirection: PPoint;
begin
  currentStep := 0;
  currentPlots := TPoints.Create;
  currentPlots.Add(FindStart);
  nextPlots := TPoints.Create;

  // Counts the start if max steps is even.
  mod2 := AMaxSteps and 1;
  if mod2 = 0 then
    Result := 1
  else
    Result := 0;

  while currentStep < AMaxSteps do
  begin
    for plot in currentPlots do
      for pdirection in CPCardinalDirections do
      begin
        next := plot + pdirection^;
        if IsInBounds(next) and (GetPosition(next) = CPlotChar) then
        begin
          SetPosition(next, CTraversedChar);
          nextPlots.Add(next);
        end;
      end;

    currentPlots.Clear;
    temp := currentPlots;
    currentPlots := nextPlots;
    nextPlots := temp;
    Inc(currentStep);

    // Positions where the number of steps are even or odd (for even or odd AMaxSteps, respectively) can be reached with
    // trivial backtracking, so they count.
    if currentStep and 1 = mod2 then
      Inc(Result, currentPlots.Count);
  end;

  currentPlots.Free;
  nextPlots.Free;
end;

function TStepCounter.CalcTargetPlotsOnInfiniteMap(const AMaxSteps: Integer): Int64;
var
  half, k, i, j: Integer;
  factor1, factor1B, factor2, factor4A: Int64;
begin
  Result := 0;

  // Asserts square input map with odd size.
  if (FWidth <> FHeight) or (FWidth and 1 = 0) then
    Exit;
  // Asserts half map size is odd.
  half := FWidth shr 1;
  if half and 1 = 0 then
    Exit;
  // Asserts that there is an even k such that maximum number of steps is equal to k + 1/2 times the map size.
  // k is the number of visited repeated maps, not counting the start map, when taking all steps in a straight line in
  // any of the four directions.
  k := (AMaxSteps - half) div FWidth;
  if (k and 1 = 0) and (AMaxSteps <> k * FWidth + half) then
    Exit;

  // Assuming that the rocks on the map are sparse enough, and the central vertical and horizontal lines are empty,
  // every free plot with odd (Manhattan) distance (not larger than AMaxSteps) to the start plot (because of trivial
  // backtracking) on the maps is reachable, essentially formning a 45-degree rotated square shape centered on the start
  // plot.

  // Inside this "diamond" shape, 2k(k - 1) + 1 (k-th centered square number) copies of the map are traversed fully.
  // However, there are two different types of these. (k - 1)^2 are traversed like the start map, where all plots with
  // odd distance to the center are reachable (type 1), and k^2 are traversed such that all plots within odd distance to
  // the center are reachable (type 2).

  // On each of the corners of this "diamond" shape, there is one map traversed fully except for two adjacent of its
  // corner triangles (type 3).

  // On each of the edges of this "diamond" shape, there are k maps where only the corner triangle facing towards the
  // shapes center is traversed (type 4), and k - 1 maps that are fully traversed except for the corner triangle facing
  // away from the shapes center (type 5).

  // The four different versions of type 4 do not overlap within a map, so they can be counted together (type 4A).

  // Types 1, 3, and 5 share patterns, so they can also be counted together, but the parts of the patterns have
  // different counts. Each corner (type 1A) is traversed (k - 1)^2 times for type 1, 2 times for type 3, and 3(k - 1)
  // for type 5, that is (k - 1)^2 + 3k - 1 in total. The center (type 1B) is traversed (k - 1)^2 times for type 1, 4
  // times for type 3, and 4(k - 1) for type 5, that is (k - 1)^2 + 4k.
  // Equivalently, instead type 1 is traversed (k - 1)^2 + 3k - 1 times and type 1B is traversed k + 1 times.

  // Types example for k = 2, half = 5:
  //   4            5            2                      4A
  //   ...........  .....O.O.O.  O.O.O.O.O.O            O.O.O.O.O.O
  //   ...........  ....O.O.O.O  .O.O.O.O.O.            .O.O...O.O.
  //   ...........  ...O.O.O.O.  O.O.O.O.O.O            O.O.....O.O
  //   ......#....  ..O.O.#.O.O  .O.O.O#O.O.            .O....#..O.
  //   ...#.......  .O.#.O.O.O.  O.O#O.O.O.O            O..#......O
  //   ...........  O.O.O.O.O.O  .O.O.O.O.O.            ...........
  //   ....#..#..O  .O.O#O.#.O.  O.O.#.O.#.O            O...#..#..O
  //   .........O.  O.O.O.O.O.O  .O.O.O.O.O.            .O.......O.
  //   ........O.O  .O.O.O.O.O.  O.O.O.O.O.O            O.O.....O.O
  //   .......O.O.  O.O.O.O.O.O  .O.O.O.O.O.            .O.O...O.O.
  //   ......O.O.O  .O.O.O.O.O.  O.O.O.O.O.O            O.O.O.O.O.O
  //
  //   3            2            1                      1A           1B
  //   .....O.O.O.  O.O.O.O.O.O  .O.O.O.O.O.            .O.O...O.O.  .....O.....
  //   ....O.O.O.O  .O.O.O.O.O.  O.O.O.O.O.O            O.O.....O.O  ....O.O....
  //   ...O.O.O.O.  O.O.O.O.O.O  .O.O.O.O.O.            .O.......O.  ...O.O.O...
  //   ..O.O.#.O.O  .O.O.O#O.O.  O.O.O.#.O.O            O.....#...O  ..O.O.#.O..
  //   .O.#.O.O.O.  O.O#O.O.O.O  .O.#.O.O.O.            ...#.......  .O.#.O.O.O.
  //   O.O.O.O.O.O  .O.O.O.O.O.  O.O.OSO.O.O            ...........  O.O.O.O.O.O
  //   .O.O#O.#.O.  O.O.#.O.#.O  .O.O#O.#.O.            ....#..#...  .O.O#O.#.O.
  //   ..O.O.O.O.O  .O.O.O.O.O.  O.O.O.O.O.O            O.........O  ..O.O.O.O..
  //   ...O.O.O.O.  O.O.O.O.O.O  .O.O.O.O.O.            .O.......O.  ...O.O.O...
  //   ....O.O.O.O  .O.O.O.O.O.  O.O.O.O.O.O            O.O.....O.O  ....O.O....
  //   .....O.O.O.  O.O.O.O.O.O  .O.O.O.O.O.            .O.O...O.O.  .....O.....

  // Sets factors, aka number of occurrences, for each type.
  factor1 := (k - 1) * (k - 1) + 3 * k - 1;
  factor1B := k + 1;
  factor2 := k * k;
  factor4A := k;
  for i := 0 to FWidth - 1 do
    for j := 1 to FWidth do
      if FLines[i][j] <> CRockChar then
        if (i and 1) = (j and 1) then
        begin
          // Counts types 1.
          Result := Result + factor1;
          // Counts types 1B.
          if not ((i + j <= half) or (i + j > FWidth + half) or (i - j >= half) or (j - i > half + 1)) then
            Result := Result + factor1B;
        end
        else begin
          // Counts types 2.
          Result := Result + factor2;
          // Counts types 4A.
          if (i + j <= half) or (i + j > FWidth + half) or (i - j >= half) or (j - i > half + 1) then
            Result := Result + factor4A;
        end
end;

constructor TStepCounter.Create(const AMaxStepsPart1: Integer; const AMaxStepsPart2: Integer);
begin
  FMaxSteps1 := AMaxStepsPart1;
  FMaxSteps2 := AMaxStepsPart2;
  FLines := TStringList.Create;
end;

destructor TStepCounter.Destroy;
begin
  FLines.Free;
  inherited Destroy;
end;

procedure TStepCounter.ProcessDataLine(const ALine: string);
begin
  FLines.Add(ALine);
end;

procedure TStepCounter.Finish;
begin
  FWidth := Length(FLines[0]);
  FHeight := FLines.Count;
  PrepareMap;

  FPart2 := CalcTargetPlotsOnInfiniteMap(FMaxSteps2);
  FPart1 := DoSteps(FMaxSteps1);
end;

function TStepCounter.GetDataFileName: string;
begin
  Result := 'step_counter.txt';
end;

function TStepCounter.GetPuzzleName: string;
begin
  Result := 'Day 21: Step Counter';
end;

end.