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

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Generics.Collections, USolver;

const
  CRoundRockChar = 'O';
  CCubeRockChar = '#';
  CEmptyChar = '.';
  CMaxSpinCount = 1000000000;

type
  TIntegers = specialize TList<Integer>;
  TIntegersList = specialize TObjectList<TIntegers>;

  { TCubeRockInterval }

  TCubeRockInterval = record
    Start, Stop: Integer;
  end;

  TCubeRockIntervals = specialize TList<TCubeRockInterval>;
  TCubeRockIntervalsList = specialize TObjectList<TCubeRockIntervals>;

  { TRoundRockFormation }

  TRoundRockFormation = class
  private
    FColumns, FRows: TIntegersList;
  public
    property Columns: TIntegersList read FColumns;
    property Rows: TIntegersList read FRows;
    constructor Create(const AWidth, AHeight: Integer);
    destructor Destroy; override;
    procedure AddRock(const AColumn, ARow: Integer);
    function CalcWeight: Integer;
    function IsEqualTo(const AOther: TRoundRockFormation): Boolean;
    function Clone: TRoundRockFormation;
  end;

  TRoundRockFormations = specialize TObjectList<TRoundRockFormation>;

  { TPlatform }

  TPlatform = class
  private
    FFormation: TRoundRockFormation;
    FColumnIntervals, FRowIntervals: TCubeRockIntervalsList;
    procedure Tilt(constref AIntervals: TCubeRockIntervalsList; constref ASource, ATarget: TIntegersList;
      const AUp: Boolean);
    procedure InitIntervals(var AIntervalsList: TCubeRockIntervalsList; const ACount, ALength: Integer);
    procedure UpdateIntervals(constref AIntervals: TCubeRockIntervals; const AIndex, AMax: Integer; const ALines:
      TStringList; const APreviousCharLineIndex, APreviousCharIndex, ANextCharLineIndex, ANextCharIndex: Integer);
  public
    property CurrentFormation: TRoundRockFormation read FFormation;
    constructor Create(const ALines: TStringList);
    destructor Destroy; override;
    procedure TiltNorth;
    procedure TiltWest;
    procedure TiltSouth;
    procedure TiltEast;
  end;

  { TParabolicReflectorDish }

  TParabolicReflectorDish = class(TSolver)
  private
    FLines: TStringList;
  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

{ TRoundRockFormation }

constructor TRoundRockFormation.Create(const AWidth, AHeight: Integer);
var
  i: Integer;
begin
  FColumns := TIntegersList.Create;
  FColumns.Count := AWidth;
  for i := 0 to FColumns.Count - 1 do
    FColumns[i] := TIntegers.Create;

  FRows := TIntegersList.Create;
  FRows.Count := AHeight;
  for i := 0 to FRows.Count - 1 do
    FRows[i] := TIntegers.Create;
end;

destructor TRoundRockFormation.Destroy;
begin
  FColumns.Free;
  FRows.Free;
  inherited Destroy;
end;

procedure TRoundRockFormation.AddRock(const AColumn, ARow: Integer);
begin
  FColumns[AColumn].Add(ARow);
end;

function TRoundRockFormation.CalcWeight: Integer;
var
  i, j: Integer;
begin
  Result := 0;

  for i := 0 to FColumns.Count - 1 do
    for j := 0 to FColumns[i].Count - 1 do
      Inc(Result, FRows.Count - FColumns[i][j]);

  for i := 0 to FRows.Count - 1 do
    Inc(Result, (FRows.Count - i) * FRows[i].Count);
end;

function TRoundRockFormation.IsEqualTo(const AOther: TRoundRockFormation): Boolean;
var
  i, j: Integer;
begin
  Result := (FColumns.Count = AOther.FColumns.Count) and (FRows.Count = AOther.FRows.Count);
  if not Result then
    Exit;

  for i := 0 to FColumns.Count - 1 do
  begin
    if FColumns[i].Count <> AOther.FColumns[i].Count then
    begin
      Result := False;
      Exit;
    end;

    for j := 0 to FColumns[i].Count - 1 do
      if FColumns[i][j] <> AOther.FColumns[i][j] then
      begin
        Result := False;
        Exit;
      end;
  end;

  for i := 0 to FRows.Count - 1 do
  begin
    if FRows[i].Count <> AOther.FRows[i].Count then
    begin
      Result := False;
      Exit;
    end;

    for j := 0 to FRows[i].Count - 1 do
      if FRows[i][j] <> AOther.FRows[i][j] then
      begin
        Result := False;
        Exit;
      end;
  end;
end;

function TRoundRockFormation.Clone: TRoundRockFormation;
var
  i, rock: Integer;
begin
  Result := TRoundRockFormation.Create(FColumns.Count, FRows.Count);

  for i := 0 to FColumns.Count - 1 do
    for rock in FColumns[i] do
      Result.FColumns[i].Add(rock);

  for i := 0 to FRows.Count - 1 do
    for rock in FRows[i] do
      Result.FRows[i].Add(rock);
end;

{ TPlatform }

procedure TPlatform.Tilt(constref AIntervals: TCubeRockIntervalsList; constref ASource, ATarget:
  TIntegersList; const AUp: Boolean);
var
  i, j, rock, nextFree, direction: Integer;
begin
  if AUp then
    direction := 1
  else
    direction := -1;
  for i := 0 to AIntervals.Count - 1 do
  begin
    j := 0;
    if AUp then
      nextFree := AIntervals[i][j].Start
    else
      nextFree := AIntervals[i][j].Stop;
    for rock in ASource[i] do
    begin
      // Goes to next interval if rock is not in current interval.
      while AIntervals[i][j].Stop < rock do
      begin
        Inc(j);
        if AUp then
          nextFree := AIntervals[i][j].Start
        else
          nextFree := AIntervals[i][j].Stop;
      end;

      // rock must now be in current interval.
      ATarget[nextFree].Add(i);
      Inc(nextFree, direction);
    end;
    ASource[i].Clear;
  end;
end;

procedure TPlatform.InitIntervals(var AIntervalsList: TCubeRockIntervalsList; const ACount, ALength: Integer);
var
  i: Integer;
  interval: TCubeRockInterval;
begin
  AIntervalsList := TCubeRockIntervalsList.Create;
  AIntervalsList.Count := ACount;
  interval.Start := 0;
  interval.Stop := ALength - 1;
  for i := 0 to ACount - 1 do
  begin
    AIntervalsList[i] := TCubeRockIntervals.Create;
    AIntervalsList[i].Add(interval);
  end;
end;

procedure TPlatform.UpdateIntervals(constref AIntervals: TCubeRockIntervals; const AIndex, AMax: Integer; const ALines:
  TStringList; const APreviousCharLineIndex, APreviousCharIndex, ANextCharLineIndex, ANextCharIndex: Integer);
var
  interval: TCubeRockInterval;
begin
  if (AIndex > 0) and (ALines[APreviousCharLineIndex][APreviousCharIndex] <> CCubeRockChar) then
  begin
    // Finishes previous interval.
    interval := AIntervals.Last;
    interval.Stop := AIndex - 1;
    AIntervals[AIntervals.Count - 1] := interval;
  end;

  if (AIntervals.Count = 1) and (AIntervals[0].Start = AIndex) then
  begin
    // Shifts first interval if not yet started.
    interval := AIntervals[0];
    interval.Start := AIndex + 1;
    AIntervals[0] := interval;
  end
  else if (AIndex < AMax) and (ALines[ANextCharLineIndex][ANextCharIndex] <> CCubeRockChar) then
  begin
    // Starts interval.
    interval.Start := AIndex + 1;
    interval.Stop := AMax;
    AIntervals.Add(interval);
  end;
end;

constructor TPlatform.Create(const ALines: TStringList);
var
  i, j, width: Integer;
begin
  width := Length(ALines[0]);
  FFormation := TRoundRockFormation.Create(width, ALines.Count);
  InitIntervals(FColumnIntervals, width, ALines.Count);
  InitIntervals(FRowIntervals, ALines.Count, width);

  for i := 0 to ALines.Count - 1 do
    for j := 1 to width do
      case ALines[i][j] of
        CRoundRockChar: FFormation.AddRock(j - 1, i);
        CCubeRockChar: begin
          UpdateIntervals(FRowIntervals[i], j - 1, width - 1, ALines, i, j - 1, i, j + 1);
          UpdateIntervals(FColumnIntervals[j - 1], i, ALines.Count - 1, ALines, i - 1 , j, i + 1, j);
        end;
      end;
end;

destructor TPlatform.Destroy;
begin
  FFormation.Free;
  FColumnIntervals.Free;
  FRowIntervals.Free;
  inherited Destroy;
end;

procedure TPlatform.TiltNorth;
begin
  Tilt(FColumnIntervals, FFormation.Columns, FFormation.Rows, True);
end;

procedure TPlatform.TiltWest;
begin
  Tilt(FRowIntervals, FFormation.Rows, FFormation.Columns, True);
end;

procedure TPlatform.TiltSouth;
begin
  Tilt(FColumnIntervals, FFormation.Columns, FFormation.Rows, False);
end;

procedure TPlatform.TiltEast;
begin
  Tilt(FRowIntervals, FFormation.Rows, FFormation.Columns, False);
end;

{ TParabolicReflectorDish }

constructor TParabolicReflectorDish.Create;
begin
  FLines := TStringList.Create;
end;

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

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

procedure TParabolicReflectorDish.Finish;
var
  platform: TPlatform;
  history: TRoundRockFormations;
  i, j, x: Integer;
  match: Boolean;
begin
  // Initializes platform.
  platform := TPlatform.Create(FLines);

  // Intializes history of platform rock formation.
  history := TRoundRockFormations.Create;
  history.Add(platform.CurrentFormation.Clone);

  // Performs spins until a rock formation from the history is encountered again.
  for i := 1 to CMaxSpinCount do
  begin
    platform.TiltNorth;
    if FPart1 = 0 then
      FPart1 := platform.CurrentFormation.CalcWeight;
    platform.TiltWest;
    platform.TiltSouth;
    platform.TiltEast;

    // Searches history for the current rock formation.
    j := 0;
    match := False;
    // history.Count - 1 because current rock formation will never be equal to the last one.
    while (j < history.Count - 1) and not match do
    begin
      match := platform.CurrentFormation.IsEqualTo(history[j]);
      if not match then
        Inc(j);
    end;

    if match then
    begin
      x := CMaxSpinCount mod (i - j);
      while x < j do
        Inc(x, i - j);
      FPart2 := history[x].CalcWeight;
      Break;
    end
    else begin
      history.Add(platform.CurrentFormation.Clone);
    end;
  end;

  history.Free;
  platform.Free;
end;

function TParabolicReflectorDish.GetDataFileName: string;
begin
  Result := 'parabolic_reflector_dish.txt';
end;

function TParabolicReflectorDish.GetPuzzleName: string;
begin
  Result := 'Day 14: Parabolic Reflector Dish';
end;

end.