Added solution for "Day 10: Pipe Maze", part 2

2023-12-11 15:03:01 +01:00
parent ac81b20db5
commit 344be871db
2 changed files with 375 additions and 106 deletions
--- a/solvers/UPipeMaze.pas
+++ b/solvers/UPipeMaze.pas
@@ -22,24 +22,52 @@ unit UPipeMaze;
 interface

 uses
-  Classes, SysUtils, USolver;
+  Classes, SysUtils, Generics.Collections, USolver;

 const
  CStartChar = 'S';

 type
-  TDirection = (drEast, drSouth, drWest, drNorth);
+  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
-    FWidth, FHeight: Integer;
-    FStrings: TStringList;
+    FStepMappings: TStepMappings;
+    FMap, FEnclosureMap: TStringList;
+    procedure InitStepMappings;
    procedure ParseMaze;
    function FindStart: TPoint;
-    procedure DoFirstStep(var APosition: TPoint; out OStartDirection: TDirection);
-    procedure DoStep(var APosition: TPoint; var ADirection: TDirection);
+    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;
@@ -51,15 +79,68 @@ type

 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(Point(0, 1), Point(0, 1), '|',
+    TPointArray.Create(Point(1, 0)),
+    TPointArray.Create(Point(-1, 0))));
+  FStepMappings.Add(TStepMapping.Create(Point(1, 0), Point(1, 0), '-',
+    TPointArray.Create(Point(0, -1)),
+    TPointArray.Create(Point(0, 1))));
+  FStepMappings.Add(TStepMapping.Create(Point(-1, 0), Point(0, -1), 'L',
+    TPointArray.Create(Point(0, 1), Point(-1, 1), Point(-1, 0)),
+    []));
+  FStepMappings.Add(TStepMapping.Create(Point(0, 1), Point(-1, 0), 'J',
+    TPointArray.Create(Point(1, 0), Point(1, 1), Point(0, 1)),
+    []));
+  FStepMappings.Add(TStepMapping.Create(Point(1, 0), Point(0, 1), '7',
+    TPointArray.Create(Point(0, -1), Point(1, -1), Point(1, 0)),
+    []));
+  FStepMappings.Add(TStepMapping.Create(Point(0, -1), Point(1, 0), 'F',
+    TPointArray.Create(Point(-1, 0), Point(-1, -1), Point(0, -1)),
+    []));
+
+  // 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: TPoint;
-  nextDirection: TDirection;
+  start, current, nextDirection: TPoint;
 begin
-  FHeight := FStrings.Count;
-  FWidth := Length(FStrings[0]);
+  FEnclosureMap := TStringList.Create;
+  FEnclosureMap.AddStrings(FMap);

  start := FindStart;
  current := start;
@@ -73,6 +154,9 @@ begin
    DoStep(current, nextDirection);
    Inc(FPart1);
  until current = start;
+
+  CountEnclosureInside;
+  FEnclosureMap.Free;
 end;

 function TPipeMaze.FindStart: TPoint;
@@ -82,12 +166,12 @@ var
 begin
  foundStart := False;
  i := 0;
-  while not foundStart and (i < FStrings.Count) do
+  while not foundStart and (i < FMap.Count) do
  begin
    j := 1;
-    while not foundStart and (j <= Length(FStrings[i])) do
+    while not foundStart and (j <= Length(FMap[i])) do
    begin
-      if FStrings[i][j] = CStartChar then
+      if FMap[i][j] = CStartChar then
      begin
        foundStart := True;
        Result.X := j;
@@ -99,126 +183,171 @@ begin
  end;
 end;

-procedure TPipeMaze.DoFirstStep(var APosition: TPoint; out OStartDirection: TDirection);
+procedure TPipeMaze.DoFirstStep(var APosition: TPoint; out OStartDirection: TPoint);
+var
+  stepMapping: TStepMapping;
+  step: TPoint;
 begin
-  // Checks going East.
-  if APosition.X < FWidth then
+  for stepMapping in FStepMappings do
  begin
-    if FStrings[APosition.Y][APosition.X + 1] = '-' then
+    step := APosition + stepMapping.StartDirection;
+    if CheckMapBounds(step) and stepMapping.TryStep(stepMapping.StartDirection, GetMapChar(step)) then
    begin
-      Inc(APosition.X);
-      OStartDirection := drEast;
-      Exit;
-    end
-    else if FStrings[APosition.Y][APosition.X + 1] = 'J' then
-    begin
-      Inc(APosition.X);
-      OStartDirection := drNorth;
-      Exit;
-    end
-    else if FStrings[APosition.Y][APosition.X + 1] = '7' then
-    begin
-      Inc(APosition.X);
-      OStartDirection := drSouth;
-      Exit;
-    end;
-  end;
+      UpdateEnclosureMap(APosition, stepMapping);
+      UpdateEnclosureMap(step, stepMapping);

-  // Checks going South.
-  if APosition.Y < FHeight - 1 then
-  begin
-    if FStrings[APosition.Y + 1][APosition.X] = '|' then
-    begin
-      Inc(APosition.Y);
-      OStartDirection := drSouth;
-      Exit;
-    end
-    else if FStrings[APosition.Y + 1][APosition.X] = 'L' then
-    begin
-      Inc(APosition.Y);
-      OStartDirection := drEast;
-      Exit;
-    end
-    else if FStrings[APosition.Y + 1][APosition.X] = 'J' then
-    begin
-      Inc(APosition.Y);
-      OStartDirection := drWest;
-      Exit;
-    end;
-  end;
-
-  // Checks going West.
-  if APosition.X > 1 then
-  begin
-    if FStrings[APosition.Y][APosition.X - 1] = '-' then
-    begin
-      Dec(APosition.X);
-      OStartDirection := drWest;
-      Exit;
-    end
-    else if FStrings[APosition.Y][APosition.X - 1] = 'L' then
-    begin
-      Dec(APosition.X);
-      OStartDirection := drNorth;
-      Exit;
-    end
-    else if FStrings[APosition.Y][APosition.X - 1] = 'F' then
-    begin
-      Dec(APosition.X);
-      OStartDirection := drSouth;
+      APosition := step;
+      OStartDirection := stepMapping.NewDirection;
      Exit;
    end;
  end;
 end;

-procedure TPipeMaze.DoStep(var APosition: TPoint; var ADirection: TDirection);
+procedure TPipeMaze.DoStep(var APosition: TPoint; var ADirection: TPoint);
+var
+  stepMapping: TStepMapping;
 begin
-  case ADirection of
-    drEast: begin
-      Inc(APosition.X);
-      case FStrings[APosition.Y][APosition.X] of
-        'J': ADirection := drNorth;
-        '7': ADirection := drSouth;
-      end;
+  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;
-    drSouth: begin
-      Inc(APosition.Y);
-      case FStrings[APosition.Y][APosition.X] of
-        'L': ADirection := drEast;
-        'J': ADirection := drWest;
+  end;
+end;
+
+procedure TPipeMaze.CountEnclosureInside;
+begin
+  if not TryCountEnclosureSide('l', FPart2) then
+    TryCountEnclosureSide('r', FPart2);
+end;
+
+function TPipeMaze.TryCountEnclosureSide(const AChar: Char; out OCount: Int64): Boolean;
+var
+  directions: TPointArray;
+  stack: specialize TStack<TPoint>;
+  i, j: Integer;
+  position, direction, neighbor: TPoint;
+  c: Char;
+begin
+  directions := TPointArray.Create(Point(0, -1), Point(-1, 0), Point(0, 1), Point(1, 0));
+  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, '%');
+        Inc(OCount);
      end;
-    end;
-    drWest: begin
-      Dec(APosition.X);
-      case FStrings[APosition.Y][APosition.X] of
-        'L': ADirection := drNorth;
-        'F': ADirection := drSouth;
-      end;
-    end;
-    drNorth: begin
-      Dec(APosition.Y);
-      case FStrings[APosition.Y][APosition.X] of
-        '7': ADirection := drWest;
-        'F': ADirection := drEast;
+
+      while stack.Count > 0 do
+      begin
+        position := stack.Pop;
+
+        for direction in directions do
+        begin
+          if CheckMapBounds(position + direction) then
+          begin
+            // Checks the neighboring position.
+            neighbor := position + direction;
+            c := GetEnclosureMapChar(neighbor);
+            if (c <> '%') and (c <> '#') then
+            begin
+              stack.Push(neighbor);
+              SetEnclosureMapChar(neighbor, '%');
+              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, '#');
+  side := AStepMapping.LeftSide;
+  c := 'l';
+  for i := 1 to 2 do
+  begin
+    for offset in side do
+    begin
+      sidePosition := APosition + offset;
+      if CheckMapBounds(sidePosition) and (GetEnclosureMapChar(sidePosition) <> '#') then
+        SetEnclosureMapChar(sidePosition, c);
+    end;
+    side := AStepMapping.RightSide;
+    c := 'r';
+  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
-  FStrings := TStringList.Create;
+  FStepMappings := TStepMappings.Create;
+  InitStepMappings;
+  FMap := TStringList.Create;
 end;

 destructor TPipeMaze.Destroy;
 begin
-  FStrings.Free;
+  FStepMappings.Free;
+  FMap.Free;
  inherited Destroy;
 end;

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

 procedure TPipeMaze.Finish;