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

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Generics.Collections, USolver, UNumberTheory;

type

  { TNode }

  TNode = class
  private
    FName: string;
    FLeft, FRight: TNode;
  public
    constructor Create(const AName: string);
    property Name: string read FName;
    procedure AddNeighbors(constref ALeft, ARight: TNode);
    function Step(const ADirection: Char): TNode;
  end;

  TNodes = specialize TObjectList<TNode>;

  { THauntedWasteland }

  THauntedWasteland = class(TSolver)
  private
    FDirections: string;
    FNextDirectionIndex: Integer;
    FNodes, FUnparsedNodes, FGhostCurrentNodes: TNodes;
    procedure ProcessNode(const ALine: string);
    procedure DoSteps;
    procedure IncDirectionIndex;
  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

{ TNode }

constructor TNode.Create(const AName: string);
begin
  FName := AName;
  FLeft := nil;
  FRight := nil;
end;

procedure TNode.AddNeighbors(constref ALeft, ARight: TNode);
begin
  FLeft := ALeft;
  FRight := ARight;
end;

function TNode.Step(const ADirection: Char): TNode;
begin
  Result := nil;
  case ADirection of
    'L':
      if FLeft <> nil then
        Result := FLeft;
    'R':
      if FRight <> nil then
        Result := FRight;
  end;
end;

{ THauntedWasteland }

procedure THauntedWasteland.ProcessNode(const ALine: string);
var
  name, left, right: string;
  i: Integer;
  parsingNode, leftNode, rightNode: TNode;
begin
  name := LeftStr(ALine, 3);
  left := Copy(ALine, 8, 3);
  right := Copy(ALine, 13, 3);

  // Tries to find the new node in unparsed nodes.
  i := 0;
  parsingNode := nil;
  while (parsingNode = nil) and (i < FUnparsedNodes.Count) do
  begin
    if FUnparsedNodes[i].Name = name then
    begin
      // New node was already encountered and is now parsed.
      parsingNode := FUnparsedNodes[i];
      FUnparsedNodes.Delete(i);
    end;
    Inc(i);
  end;

  // Adds new node to list of all nodes. We do this before looking for leftNode and rightNode because the node might
  // reference itself.
  if parsingNode = nil then
  begin
    parsingNode := TNode.Create(name);
    FNodes.Add(parsingNode);
  end;

  // Tries to find leftNode and rightNode.
  i := 0;
  leftNode := nil;
  rightNode := nil;
  while ((leftNode = nil) or (rightNode = nil)) and (i < FNodes.Count) do
  begin
    if (leftNode = nil) and (FNodes[i].Name = left) then
    begin
      leftNode := FNodes[i];
    end;
    if (rightNode = nil) and (FNodes[i].Name = right) then
    begin
      rightNode := FNodes[i];
    end;
    Inc(i);
  end;

  // Adds leftNode and/or rightNode to list of all nodes and unparsed nodes.
  if leftNode = nil then
  begin
    leftNode := TNode.Create(left);
    FNodes.Add(leftNode);
    FUnparsedNodes.Add(leftNode);
  end;
  if rightNode = nil then
  begin
    if right = left then
      // This happens only if both left and right nodes are new.
      rightNode := leftNode
    else begin
      rightNode := TNode.Create(right);
      FNodes.Add(rightNode);
      FUnparsedNodes.Add(rightNode);
    end;
  end;

  parsingNode.AddNeighbors(leftNode, rightNode);

  // Checks for start nodes.
  if name[3] = 'A' then
    FGhostCurrentNodes.Add(parsingNode);
end;

procedure THauntedWasteland.DoSteps;
var
  counts: specialize TList<Cardinal>;
  gcd, count: Cardinal;
  node, current: TNode;
begin
  gcd := 0;
  counts := specialize TList<Cardinal>.Create;
  counts.Capacity := FGhostCurrentNodes.Count;

  for node in FGhostCurrentNodes do
  begin
    current := node;
    FNextDirectionIndex := 1;
    count := 0;
    repeat
      current := current.Step(FDirections[FNextDirectionIndex]);
      IncDirectionIndex;
      Inc(count);
    until current.Name[3] = 'Z';

    if node.Name = 'AAA' then
      FPart1 := count;

    counts.Add(count);
    if gcd = 0 then
      gcd := count;
    gcd := TNumberTheory.GreatestCommonDivisor(gcd, count);
  end;

  for count in counts do
  begin
    if FPart2 = 0 then
      FPart2 := count
    else
      FPart2 := count div gcd * FPart2;
  end;

  counts.Free;
end;

procedure THauntedWasteland.IncDirectionIndex;
begin
  Inc(FNextDirectionIndex);
  if FNextDirectionIndex > Length(FDirections) then
    FNextDirectionIndex := 1;
end;

constructor THauntedWasteland.Create;
begin
  FNodes := TNodes.Create;
  FUnparsedNodes := TNodes.Create(False);
  FGhostCurrentNodes := TNodes.Create(False);
end;

destructor THauntedWasteland.Destroy;
begin
  FNodes.Free;
  FUnparsedNodes.Free;
  FGhostCurrentNodes.Free;
  inherited Destroy;
end;

procedure THauntedWasteland.ProcessDataLine(const ALine: string);
begin
  if FDirections = '' then
    FDirections := ALine
  else if ALine <> '' then
    ProcessNode(ALine);
end;

procedure THauntedWasteland.Finish;
begin
  DoSteps;
end;

function THauntedWasteland.GetDataFileName: string;
begin
  Result := 'haunted_wasteland.txt';
end;

function THauntedWasteland.GetPuzzleName: string;
begin
  Result := 'Day 8: Haunted Wasteland';
end;

end.