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

{$mode ObjFPC}{$H+}

interface

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

type

  { TBeam }

  TBeam = record
    Position, Direction: TPoint;
  end;

  TEnergyState = (esNone, esWestOrHorizontal, esEastOrVertical, esBoth);

  { TTransition }

  TTransition = record
    IncomingDirection, OutgoingDirection, SplitDirection: PPoint;
    Tile: Char;
    EnergyChange: TEnergyState;
  end;

  { TEnergyMap }

  TEnergyMap = class
  private
    FWidth, FHeight: Integer;
    FStates: array of array of TEnergyState;
  public
    constructor Create(const AWidth, AHeight: Integer);
    function IsBeamOutOfBounds(constref ABeam: TBeam): Boolean;
    function Energize(constref APosition: TPoint; const AChange: TEnergyState): Boolean;
    function CalcEnergizedTiles: Int64;
  end;

  { TFloorWillBeLava }

  TFloorWillBeLava = class(TSolver)
  private
    FLines: TStringList;
    function GetTile(constref APosition: TPoint): Char;
    function GetNewBeam(constref APosition, ADirection: TPoint): TBeam;
    function ProcessBeam(ABeam: TBeam): Int64;
  public
    constructor Create;
    destructor Destroy; override;
    procedure ProcessDataLine(const ALine: string); override;
    procedure Finish; override;
    function GetDataFileName: string; override;
    function GetPuzzleName: string; override;
  end;

const
  CEmptyChar = '.';
  CTransitions: array of TTransition = (
    (IncomingDirection: @CDirectionRight; OutgoingDirection: @CDirectionUp; SplitDirection: @CNoDirection; Tile: '/';
      EnergyChange: esWestOrHorizontal),
    (IncomingDirection: @CDirectionDown; OutgoingDirection: @CDirectionLeft; SplitDirection: @CNoDirection; Tile: '/';
      EnergyChange: esWestOrHorizontal),
    (IncomingDirection: @CDirectionLeft; OutgoingDirection: @CDirectionDown; SplitDirection: @CNoDirection; Tile: '/';
      EnergyChange: esEastOrVertical),
    (IncomingDirection: @CDirectionUp; OutgoingDirection: @CDirectionRight; SplitDirection: @CNoDirection; Tile: '/';
      EnergyChange: esEastOrVertical),
    (IncomingDirection: @CDirectionRight; OutgoingDirection: @CDirectionDown; SplitDirection: @CNoDirection; Tile: '\';
      EnergyChange: esWestOrHorizontal),
    (IncomingDirection: @CDirectionDown; OutgoingDirection: @CDirectionRight; SplitDirection: @CNoDirection; Tile: '\';
      EnergyChange: esEastOrVertical),
    (IncomingDirection: @CDirectionLeft; OutgoingDirection: @CDirectionUp; SplitDirection: @CNoDirection; Tile: '\';
      EnergyChange: esEastOrVertical),
    (IncomingDirection: @CDirectionUp; OutgoingDirection: @CDirectionLeft; SplitDirection: @CNoDirection; Tile: '\';
      EnergyChange: esWestOrHorizontal),
    (IncomingDirection: @CDirectionRight; OutgoingDirection: @CDirectionUp; SplitDirection: @CDirectionDown; Tile: '|';
      EnergyChange: esBoth),
    (IncomingDirection: @CDirectionLeft; OutgoingDirection: @CDirectionUp; SplitDirection: @CDirectionDown; Tile: '|';
      EnergyChange: esBoth),
    (IncomingDirection: @CDirectionDown; OutgoingDirection: @CDirectionLeft; SplitDirection: @CDirectionRight; Tile: '-';
      EnergyChange: esBoth),
    (IncomingDirection: @CDirectionUp; OutgoingDirection: @CDirectionLeft; SplitDirection: @CDirectionRight; Tile: '-';
      EnergyChange: esBoth)
  );

implementation

{ TEnergyMap }

constructor TEnergyMap.Create(const AWidth, AHeight: Integer);
var
  i, j: Integer;
begin
  FWidth := AWidth;
  FHeight := AHeight;
  SetLength(FStates, FWidth, FHeight);
  for i := 0 to FWidth - 1 do
    for j := 0 to FHeight - 1 do
      FStates[i, j] := esNone;
end;

function TEnergyMap.IsBeamOutOfBounds(constref ABeam: TBeam): Boolean;
begin
  Result := (ABeam.Position.X < 0) or (ABeam.Position.X >= FWidth)
    or (ABeam.Position.Y < 0) or (ABeam.Position.Y >= FHeight);
end;

function TEnergyMap.Energize(constref APosition: TPoint; const AChange: TEnergyState): Boolean;
begin
  Result := False;
  case FStates[APosition.X, APosition.Y] of
    esNone: FStates[APosition.X, APosition.Y] := AChange;
    esWestOrHorizontal:
      if AChange = esEastOrVertical then
        FStates[APosition.X, APosition.Y] := esBoth
      else
        Result := True;
    esEastOrVertical:
      if AChange = esWestOrHorizontal then
        FStates[APosition.X, APosition.Y] := esBoth
      else
        Result := True;
    esBoth: Result := True;
  end;
end;

function TEnergyMap.CalcEnergizedTiles: Int64;
var
  i, j: Integer;
begin
  Result := 0;
  for i := 0 to FWidth - 1 do
    for j := 0 to FHeight - 1 do
      if FStates[i, j] <> esNone then
        Inc(Result);
end;

{ TFloorWillBeLava }

function TFloorWillBeLava.GetTile(constref APosition: TPoint): Char;
begin
  Result := FLines[APosition.Y][APosition.X + 1];
end;

function TFloorWillBeLava.GetNewBeam(constref APosition, ADirection: TPoint): TBeam;
begin
  Result.Position := APosition;
  Result.Direction := ADirection;
end;

function TFloorWillBeLava.ProcessBeam(ABeam: TBeam): Int64;
var
  done: Boolean;
  energyMap: TEnergyMap;
  stack: specialize TStack<TBeam>;
  transition: TTransition;
  energyChange: TEnergyState;
begin
  done := False;
  energyMap := TEnergyMap.Create(Length(FLines[0]), FLines.Count);
  stack := specialize TStack<TBeam>.Create;

  repeat
    // Processes the current beam.
    if energyMap.IsBeamOutOfBounds(ABeam) then
      done := True
    else begin
      if ABeam.Direction.X <> 0 then
        energyChange := esWestOrHorizontal
      else
        energyChange := esEastOrVertical;

      if GetTile(ABeam.Position) <> CEmptyChar then
      begin
        // Checks the current position for direction changes and splits.
        for transition in CTransitions do
          if (transition.IncomingDirection^ = ABeam.Direction) and (transition.Tile = GetTile(ABeam.Position)) then
          begin
            if transition.SplitDirection^ <> CNoDirection then
              stack.Push(GetNewBeam(ABeam.Position + transition.SplitDirection^, transition.SplitDirection^));
            ABeam.Direction := transition.OutgoingDirection^;
            energyChange := transition.EnergyChange;
            Break;
          end;
      end;

      done := energyMap.Energize(ABeam.Position, energyChange);

      // Moves the beam.
      ABeam.Position := ABeam.Position + ABeam.Direction;
    end;

    if done and (stack.Count > 0) then
    begin
      // Starts the next beam that was split earlier.
      done := False;
      ABeam := stack.Pop;
    end;
  until done;

  stack.Free;

  Result := energyMap.CalcEnergizedTiles;
  energyMap.Free;
end;

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

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

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

procedure TFloorWillBeLava.Finish;
var
  i, x, y, width, height: Integer;
  beam: TBeam;
  count: Int64;
begin
  width := Length(FLines[0]);
  height := FLines.Count;
  for y := 0 to 1 do
    for x := 0 to 1 do
    begin
      // Direction is horizontal for y = 0, and vertical for y = 1.
      // Direction is positive for x = 0, and negative for x = 1.
      beam.Direction := Point((1 - 2 * x) * (1 - y), (1 - 2 * x) * y);
      // Looping over the height for y = 0, and over the width for y = 1.
      for i := 0 to height - 1 + (width - height) * y do
      begin
        // Position is at left or top for x = 0, and right or bottom for x = 1.
        beam.Position := Point((x * (width - 1)) * (1 - y) + i * y, (x * (height - 1) - i) * y + i);
        count := ProcessBeam(beam);
        if FPart1 <= 0 then
          FPart1 := count;
        if FPart2 < count then
          FPart2 := count;
      end;
    end;
end;

function TFloorWillBeLava.GetDataFileName: string;
begin
  Result := 'the_floor_will_be_lava.txt';
end;

function TFloorWillBeLava.GetPuzzleName: string;
begin
  Result := 'Day 16: The Floor Will Be Lava';
end;

end.