AdventOfCode2023/solvers/UClumsyCrucible.pas

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

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Generics.Collections, Math, USolver, UCommon;

type

  { TAxisData }

  TAxisData = record
    // The current minimum total heat loss to get from this node to the end if the first step is on this axis.
    Minimum: Cardinal;
    // True, if and only if the minimum has been set, i.e. a path has been found from this node to the end, with the
    // first step on this axis.
    IsTraversed,
    // True. if a close node was updated (traversed) on the other axis, such that this minimum might be outdated. This
    // means that if this node is on the work list, NeedsUpdate is True for at least one of the axes.
    NeedsUpdate: Boolean;
  end;

  TAxisId = (axHorizontal, axVertical);

const
  CAxisDirections: array[TAxisId] of array[0..1] of PPoint
    = ((@CDirectionRight, @CDirectionLeft), (@CDirectionDown, @CDirectionUp));
  COtherAxes: array[TAxisId] of TAxisId = (axVertical, axHorizontal);

type
  { TNode }

  TNode = record
    Axes: array[TAxisId] of TAxisData;
    LocalHeatLoss: Byte;
  end;
  PNode = ^TNode;

  TNodeArray = array of TNode;
  TNodeArrays = specialize TList<TNodeArray>;

  TWorkQueue = specialize TQueue<TPoint>;

  { TNodeMap }

  TNodeMap = class
  private
    // Each item in FNodes is a horizontal row of nodes.
    FNodes: TNodeArrays;
    FWidth: Integer;
    FMinStraight, FMaxStraight: Integer;
    function GetHeight: Integer;
    function GetNode(APosition: TPoint): TNode;
    function GetPNode(APosition: TPoint): PNode;
    function IsPositionInMap(constref APosition: TPoint): Boolean;
    procedure ClampPositionToMap(var APosition: TPoint);
    procedure InitWorkQueue(constref AWorkQueue: TWorkQueue);
    procedure InvalidateNeighbors(constref AWorkQueue: TWorkQueue; const AAxis: TAxisId; constref APosition: TPoint);
    function FindStepNodeMinimum(const AAxis: TAxisId; constref APosition: TPoint): Cardinal;
  public
    property Width: Integer read FWidth;
    property Height: Integer read GetHeight;
    constructor Create;
    destructor Destroy; override;
    procedure AddNodes(const ALine: string);
    function FindMinimumPathLength(const AMinStraight, AMaxStraight: Integer): Cardinal;
    procedure Reset;
  end;

  { TClumsyCrucible }

  TClumsyCrucible = class(TSolver)
  private
    FMap: TNodeMap;
  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

const
  CMinStraight = 1;
  CMaxStraight = 3;
  CUltraMinStraight = 4;
  CUltraMaxStraight = 10;

{ TNodeMap }

function TNodeMap.GetHeight: Integer;
begin
  Result := FNodes.Count;
end;

function TNodeMap.GetNode(APosition: TPoint): TNode;
begin
  Result := FNodes[APosition.Y][APosition.X];
end;

function TNodeMap.GetPNode(APosition: TPoint): PNode;
begin
  Result := @FNodes[APosition.Y][APosition.X];
end;

function TNodeMap.IsPositionInMap(constref APosition: TPoint): Boolean;
begin
  Result := (0 <= APosition.X) and (APosition.X < Width) and (0 <= APosition.Y) and (APosition.Y < Height);
end;

procedure TNodeMap.ClampPositionToMap(var APosition: TPoint);
begin
  if APosition.X < -1 then
    APosition.X := -1
  else if APosition.X > Width then
    APosition.X := Width;
  if APosition.Y < -1 then
    APosition.Y := -1
  else if APosition.Y > Height then
    APosition.Y := Height;
end;

procedure TNodeMap.InitWorkQueue(constref AWorkQueue: TWorkQueue);
var
  position: TPoint;
  last: PNode;
  axis: TAxisId;
begin
  // Initializes the end node and the work queue with its neighbors.
  position := Point(Width - 1, Height - 1);
  last := GetPNode(position);
  for axis in TAxisId do
  begin
    last^.Axes[axis].Minimum := 0;
    last^.Axes[axis].IsTraversed := True;
  end;
  InvalidateNeighbors(AWorkQueue, axHorizontal, position);
  InvalidateNeighbors(AWorkQueue, axVertical, position);
end;

procedure TNodeMap.InvalidateNeighbors(constref AWorkQueue: TWorkQueue; const AAxis: TAxisId; constref APosition:
  TPoint);
var
  otherAxis: TAxisId;
  nodeMinimum: Cardinal;
  direction: PPoint;
  neighborPos, stop: TPoint;
  neighbor: PNode;
begin
  otherAxis := COtherAxes[AAxis];
  nodeMinimum := GetNode(APosition).Axes[otherAxis].Minimum;

  for direction in CAxisDirections[AAxis] do
  begin
    neighborPos := Point(APosition.X + direction^.X * FMinStraight, APosition.Y + direction^.Y * FMinStraight);
    if IsPositionInMap(neighborPos) then
    begin
      stop := Point(APosition.X + direction^.X * (FMaxStraight + 1), APosition.Y + direction^.Y * (FMaxStraight + 1));
      ClampPositionToMap(stop);
      while neighborPos <> stop do
      begin
        neighbor := GetPNode(neighborPos);
        if not neighbor^.Axes[AAxis].NeedsUpdate
        and (not neighbor^.Axes[AAxis].IsTraversed or (neighbor^.Axes[AAxis].Minimum > nodeMinimum)) then
        begin
          neighbor^.Axes[AAxis].NeedsUpdate := True;
          if not neighbor^.Axes[otherAxis].NeedsUpdate then
            AWorkQueue.Enqueue(neighborPos);
        end;
        neighborPos := neighborPos + direction^;
      end;
    end;
  end;
end;

function TNodeMap.FindStepNodeMinimum(const AAxis: TAxisId; constref APosition: TPoint): Cardinal;
var
  otherAxis: TAxisId;
  direction: PPoint;
  acc: Cardinal;
  neighborPos, start, stop: TPoint;
  isStartReached: Boolean;
  neighbor: TNode;
begin
  otherAxis := COtherAxes[AAxis];
  Result := Cardinal.MaxValue;

  for direction in CAxisDirections[AAxis] do
  begin
    acc := 0;
    isStartReached := False;
    neighborPos := APosition + direction^;
    start := Point(APosition.X + direction^.X * FMinStraight, APosition.Y + direction^.Y * FMinStraight);
    if IsPositionInMap(start) then
    begin
      stop := Point(APosition.X + direction^.X * (FMaxStraight + 1), APosition.Y + direction^.Y * (FMaxStraight + 1));
      ClampPositionToMap(stop);
      while neighborPos <> stop do
      begin
        if neighborPos = start then
          isStartReached := True;
        neighbor := GetNode(neighborPos);
        Inc(acc, neighbor.LocalHeatLoss);
        if isStartReached and neighbor.Axes[otherAxis].IsTraversed then
          Result := Min(Result, neighbor.Axes[otherAxis].Minimum + acc);
        neighborPos := neighborPos + direction^;
      end;
    end;
  end;
end;

constructor TNodeMap.Create;
begin
  FNodes := TNodeArrays.Create;
end;

destructor TNodeMap.Destroy;
begin
  FNodes.Free;
  inherited Destroy;
end;

procedure TNodeMap.AddNodes(const ALine: string);
var
  i: Integer;
  nodes: TNodeArray;
  axis: TAxisId;
begin
  FWidth := Length(ALine);
  SetLength(nodes, FWidth);
  for i := 0 to FWidth - 1 do
  begin
    nodes[i].LocalHeatLoss := StrToInt(ALine[i + 1]);
    for axis in TAxisId do
    begin
      nodes[i].Axes[axis].IsTraversed := False;
      nodes[i].Axes[axis].NeedsUpdate := False;
    end;
  end;
  FNodes.Add(nodes);
end;

function TNodeMap.FindMinimumPathLength(const AMinStraight, AMaxStraight: Integer): Cardinal;
var
  queue: TWorkQueue;
  position: TPoint;
  node: PNode;
  axis: TAxisId;
  start: TNode;
  newMinimum: Cardinal;
begin
  FMinStraight := AMinStraight;
  FMaxStraight := AMaxStraight;

  queue := TWorkQueue.Create;
  InitWorkQueue(queue);

  // Processes work queue.
  while queue.Count > 0 do
  begin
    position := queue.Dequeue;
    node := GetPNode(position);

    for axis in TAxisId do
      if node^.Axes[axis].NeedsUpdate then
      begin
        node^.Axes[axis].NeedsUpdate := False;
        // Finds minimum for one step from this node along this axis.
        newMinimum := FindStepNodeMinimum(axis, position);
        if not node^.Axes[axis].IsTraversed or (node^.Axes[axis].Minimum > newMinimum) then
        begin
          // Updates this axis minimum and queues update for neighbors on the other axis.
          node^.Axes[axis].IsTraversed := True;
          node^.Axes[axis].Minimum := newMinimum;
          InvalidateNeighbors(queue, COtherAxes[axis], position);
        end;
      end;
  end;

  queue.Free;

  start := GetNode(Point(0, 0));
  Result := Min(start.Axes[axHorizontal].Minimum, start.Axes[axVertical].Minimum);
end;

procedure TNodeMap.Reset;
var
  i, j: Integer;
  axis: TAxisId;
begin
  for i := 0 to Width - 1 do
    for j := 0 to Height - 1 do
      for axis in TAxisId do
      begin
        FNodes[j][i].Axes[axis].IsTraversed := False;
        FNodes[j][i].Axes[axis].NeedsUpdate := False;
      end;
end;

{ TClumsyCrucible }

constructor TClumsyCrucible.Create;
begin
  FMap := TNodeMap.Create;
end;

destructor TClumsyCrucible.Destroy;
begin
  FMap.Free;
  inherited Destroy;
end;

procedure TClumsyCrucible.ProcessDataLine(const ALine: string);
begin
  FMap.AddNodes(ALine);
end;

procedure TClumsyCrucible.Finish;
begin
  FPart1 := FMap.FindMinimumPathLength(CMinStraight, CMaxStraight);
  FMap.Reset;
  FPart2 := FMap.FindMinimumPathLength(CUltraMinStraight, CUltraMaxStraight);
end;

function TClumsyCrucible.GetDataFileName: string;
begin
  Result := 'clumsy_crucible.txt';
end;

function TClumsyCrucible.GetPuzzleName: string;
begin
  Result := 'Day 17: Clumsy Crucible';
end;

end.