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

{$mode ObjFPC}{$H+}

interface

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

const
  CStartChar = 'S';
  CLeftChar = 'l';
  CRightChar = 'r';
  CPathChar = '#';
  CFloodFillChar = '%';

type
  TPointArray = array of TPoint;

  { TStepMapping }

  TStepMapping = class
  private
    FStartDirection, FNewDirection: TPoint;
    FMapChar: Char;
    FLeftSide, FRightSide: TPointArray;
  public
    property StartDirection: TPoint read FStartDirection;
    property NewDirection: TPoint read FNewDirection;
    property LeftSide: TPointArray read FLeftSide;
    property RightSide: TPointArray read FRightSide;
    constructor Create(const AStartDirection, ANewDirection: TPoint; const AMapChar: Char; const ALeftSide,
      ARightSide: TPointArray);
    constructor CreateReverse(constref AOriginal: TStepMapping);
    function TryStep(const AStartDirection: TPoint; const AMapChar: Char): Boolean;
  end;

  TStepMappings = specialize TObjectList<TStepMapping>;

  { TPipeMaze }

  TPipeMaze = class(TSolver)
  private
    FStepMappings: TStepMappings;
    FMap, FEnclosureMap: TStringList;
    procedure InitStepMappings;
    procedure ParseMaze;
    function FindStart: TPoint;
    procedure DoFirstStep(var APosition: TPoint; out OStartDirection: TPoint);
    procedure DoStep(var APosition: TPoint; var ADirection: TPoint);
    procedure CountEnclosureInside;
    function TryCountEnclosureSide(const AChar: Char; out OCount: Int64): Boolean;
    procedure UpdateEnclosureMap(const APosition: TPoint; constref AStepMapping: TStepMapping);
    function CheckMapBounds(const APosition: TPoint): Boolean;
    function GetMapChar(const APosition: TPoint): Char;
    function GetEnclosureMapChar(const APosition: TPoint): Char;
    procedure SetEnclosureMapChar(const APosition: TPoint; const AChar: Char);
  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

{ TStepMapping }

constructor TStepMapping.Create(const AStartDirection, ANewDirection: TPoint; const AMapChar: Char; const ALeftSide,
  ARightSide: TPointArray);
begin
  FStartDirection := AStartDirection;
  FNewDirection := ANewDirection;
  FMapChar := AMapChar;
  FLeftSide := ALeftSide;
  FRightSide := ARightSide;
end;

constructor TStepMapping.CreateReverse(constref AOriginal: TStepMapping);
begin
  FStartDirection := Point(-AOriginal.FNewDirection.X, -AOriginal.FNewDirection.Y);
  FNewDirection := Point(-AOriginal.FStartDirection.X, -AOriginal.FStartDirection.Y);
  FMapChar := AOriginal.FMapChar;
  FLeftSide := AOriginal.FRightSide;
  FRightSide := AOriginal.FLeftSide;
end;

function TStepMapping.TryStep(const AStartDirection: TPoint; const AMapChar: Char): Boolean;
begin
  Result := (FStartDirection = AStartDirection) and (FMapChar = AMapChar);
end;

{ TPipeMaze }

procedure TPipeMaze.InitStepMappings;
var
  i: Integer;
begin
  FStepMappings.Add(TStepMapping.Create(CDirectionDown, CDirectionDown, '|',
    TPointArray.Create(CDirectionRight), TPointArray.Create(CDirectionLeft)));
  FStepMappings.Add(TStepMapping.Create(CDirectionRight, CDirectionRight, '-',
    TPointArray.Create(CDirectionUp), TPointArray.Create(CDirectionDown)));
  FStepMappings.Add(TStepMapping.Create(CDirectionLeft, CDirectionUp, 'L',
    TPointArray.Create(CDirectionDown, CDirectionLeftDown, CDirectionLeft), []));
  FStepMappings.Add(TStepMapping.Create(CDirectionDown, CDirectionLeft, 'J',
    TPointArray.Create(CDirectionRight, CDirectionRightDown, CDirectionDown), []));
  FStepMappings.Add(TStepMapping.Create(CDirectionRight, CDirectionDown, '7',
    TPointArray.Create(CDirectionUp, CDirectionRightUp, CDirectionRight), []));
  FStepMappings.Add(TStepMapping.Create(CDirectionUp, CDirectionRight, 'F',
    TPointArray.Create(CDirectionLeft, CDirectionLeftUp, CDirectionUp), []));

  // Adds reverse step mappings.
  for i := 0 to FStepMappings.Count - 1 do
    FStepMappings.Add(TStepMapping.CreateReverse(FStepMappings[i]));
end;

procedure TPipeMaze.ParseMaze;
var
  start, current, nextDirection: TPoint;
begin
  FEnclosureMap := TStringList.Create;
  FEnclosureMap.AddStrings(FMap);

  start := FindStart;
  current := start;

  DoFirstStep(current, nextDirection);
  DoStep(current, nextDirection);
  Inc(FPart1);

  repeat
    DoStep(current, nextDirection);
    DoStep(current, nextDirection);
    Inc(FPart1);
  until current = start;

  CountEnclosureInside;
  FEnclosureMap.Free;
end;

function TPipeMaze.FindStart: TPoint;
var
  i, j: Integer;
  foundStart: Boolean;
begin
  foundStart := False;
  i := 0;
  while not foundStart and (i < FMap.Count) do
  begin
    j := 1;
    while not foundStart and (j <= Length(FMap[i])) do
    begin
      if FMap[i][j] = CStartChar then
      begin
        foundStart := True;
        Result.X := j;
        Result.Y := i;
      end;
      Inc(j);
    end;
    Inc(i);
  end;
end;

procedure TPipeMaze.DoFirstStep(var APosition: TPoint; out OStartDirection: TPoint);
var
  stepMapping: TStepMapping;
  step: TPoint;
begin
  for stepMapping in FStepMappings do
  begin
    step := APosition + stepMapping.StartDirection;
    if CheckMapBounds(step) and stepMapping.TryStep(stepMapping.StartDirection, GetMapChar(step)) then
    begin
      UpdateEnclosureMap(APosition, stepMapping);
      UpdateEnclosureMap(step, stepMapping);

      APosition := step;
      OStartDirection := stepMapping.NewDirection;
      Exit;
    end;
  end;
end;

procedure TPipeMaze.DoStep(var APosition: TPoint; var ADirection: TPoint);
var
  stepMapping: TStepMapping;
begin
  APosition := APosition + ADirection;
  for stepMapping in FStepMappings do
  begin
    if stepMapping.TryStep(ADirection, GetMapChar(APosition)) then
    begin
      ADirection := stepMapping.NewDirection;
      UpdateEnclosureMap(APosition, stepMapping);
      Exit;
    end;
  end;
end;

procedure TPipeMaze.CountEnclosureInside;
begin
  if not TryCountEnclosureSide(CLeftChar, FPart2) then
    TryCountEnclosureSide(CRightChar, FPart2);
end;

function TPipeMaze.TryCountEnclosureSide(const AChar: Char; out OCount: Int64): Boolean;
var
  stack: specialize TStack<TPoint>;
  i, j: Integer;
  position, neighbor: TPoint;
  pdirection: PPoint;
  c: Char;
begin
  stack := specialize TStack<TPoint>.Create;

  OCount := 0;
  Result := True;

  for i := 0 to FEnclosureMap.Count - 1 do
  begin
    for j := 1 to Length(FEnclosureMap[i]) do
    begin
      position := Point(j, i);
      if GetEnclosureMapChar(position) = AChar then
      begin
        stack.Push(position);
        SetEnclosureMapChar(position, CFloodFillChar);
        Inc(OCount);
      end;

      while stack.Count > 0 do
      begin
        position := stack.Pop;

        for pdirection in CPCardinalDirections do
        begin
          if CheckMapBounds(position + pdirection^) then
          begin
            // Checks the neighboring position.
            neighbor := position + pdirection^;
            c := GetEnclosureMapChar(neighbor);
            if (c <> CFloodFillChar) and (c <> CPathChar) then
            begin
              stack.Push(neighbor);
              SetEnclosureMapChar(neighbor, CFloodFillChar);
              Inc(OCount);
            end;
          end else
          begin
            // Exits after hitting an edge of the map.
            Result := False;
            stack.Free;
            Exit;
          end;
        end;
      end;
    end;
  end;

  stack.Free;
end;

procedure TPipeMaze.UpdateEnclosureMap(const APosition: TPoint; constref AStepMapping: TStepMapping);
var
  offset, sidePosition: TPoint;
  side: TPointArray;
  c: Char;
  i: Integer;
begin
  SetEnclosureMapChar(APosition, CPathChar);
  side := AStepMapping.LeftSide;
  c := CLeftChar;
  for i := 1 to 2 do
  begin
    for offset in side do
    begin
      sidePosition := APosition + offset;
      if CheckMapBounds(sidePosition) and (GetEnclosureMapChar(sidePosition) <> CPathChar) then
        SetEnclosureMapChar(sidePosition, c);
    end;
    side := AStepMapping.RightSide;
    c := CRightChar;
  end;
end;

function TPipeMaze.CheckMapBounds(const APosition: TPoint): Boolean;
begin
  Result := (0 <= APosition.Y) and (APosition.Y < FMap.Count)
    and (0 < APosition.X) and (APosition.X <= Length(FMap[0]));
end;

function TPipeMaze.GetMapChar(const APosition: TPoint): Char;
begin
  Result := FMap[APosition.Y][APosition.X];
end;

function TPipeMaze.GetEnclosureMapChar(const APosition: TPoint): Char;
begin
  Result := FEnclosureMap[APosition.Y][APosition.X];
end;

procedure TPipeMaze.SetEnclosureMapChar(const APosition: TPoint; const AChar: Char);
var
  s: string;
begin
  s := FEnclosureMap[APosition.Y];
  s[APosition.X] := AChar;
  FEnclosureMap[APosition.Y] := s;
end;

constructor TPipeMaze.Create;
begin
  FStepMappings := TStepMappings.Create;
  InitStepMappings;
  FMap := TStringList.Create;
end;

destructor TPipeMaze.Destroy;
begin
  FStepMappings.Free;
  FMap.Free;
  inherited Destroy;
end;

procedure TPipeMaze.ProcessDataLine(const ALine: string);
begin
  FMap.Add(ALine);
end;

procedure TPipeMaze.Finish;
begin
  ParseMaze;
end;

function TPipeMaze.GetDataFileName: string;
begin
  Result := 'pipe_maze.txt';
end;

function TPipeMaze.GetPuzzleName: string;
begin
  Result := 'Day 10: Pipe Maze';
end;

end.