From 515d39da40fc99108769bd329d97eed7b734e310 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Stefan=20M=C3=BCller?= <stefan.mueller@aksdb.de>
Date: Mon, 18 Dec 2023 20:30:24 +0100
Subject: [PATCH] Updated day 14 algorithm to not operate directly on the
 strings

---
 solvers/UParabolicReflectorDish.pas | 605 +++++++++++++++-------------
 1 file changed, 335 insertions(+), 270 deletions(-)

diff --git a/solvers/UParabolicReflectorDish.pas b/solvers/UParabolicReflectorDish.pas
index f62740e..5658d5b 100644
--- a/solvers/UParabolicReflectorDish.pas
+++ b/solvers/UParabolicReflectorDish.pas
@@ -31,48 +31,64 @@ const
   CMaxSpinCount = 1000000000;
 
 type
+  TIntegers = specialize TList<Integer>;
+  TIntegersList = specialize TObjectList<TIntegers>;
 
-  { TRockPile }
+  { TCubeRockInterval }
 
-  TRockPile = class
-  private
-    FStart, FLength: Integer;
-  public
-    constructor Create(const AStart: Integer);
-    procedure AddRock;
-    function Any: Boolean;
-    procedure SetStart(const AStart: Integer);
-    function CalcWeight(const ALineCount: Integer): Integer;
+  TCubeRockInterval = record
+    Start, Stop: Integer;
   end;
 
-  TRockPiles = specialize TObjectList<TRockPile>;
+  TCubeRockIntervals = specialize TList<TCubeRockInterval>;
+  TCubeRockIntervalsList = specialize TObjectList<TCubeRockIntervals>;
+
+  { TRoundRockFormation }
+
+  TRoundRockFormation = class
+  private
+    FColumns, FRows: TIntegersList;
+  public
+    property Columns: TIntegersList read FColumns;
+    property Rows: TIntegersList read FRows;
+    constructor Create(const AWidth, AHeight: Integer);
+    destructor Destroy; override;
+    procedure AddRock(const AColumn, ARow: Integer);
+    function CalcWeight: Integer;
+    function IsEqualTo(const AOther: TRoundRockFormation): Boolean;
+    function Clone: TRoundRockFormation;
+  end;
+
+  TRoundRockFormations = specialize TObjectList<TRoundRockFormation>;
 
   { TPlatform }
 
   TPlatform = class
   private
-    FLines: TStringList;
-    procedure TiltNorth;
-    procedure TiltSouth;
-    procedure TiltWest;
-    procedure TiltEast;
-    function IsEqualTo(const FOther: TStringList): Boolean;
-    procedure SwapRockLocation(const AColumn, ARockLineIndex, AEmptyLineIndex: Integer);
+    FFormation: TRoundRockFormation;
+    FColumnIntervals, FRowIntervals: TCubeRockIntervalsList;
+    procedure Tilt(constref AIntervals: TCubeRockIntervalsList; constref ASource, ATarget: TIntegersList;
+      const AUp: Boolean);
+    procedure InitIntervals(var AIntervalsList: TCubeRockIntervalsList; const ACount, ALength: Integer);
+    procedure UpdateIntervals(constref AIntervals: TCubeRockIntervals; const AIndex, AMax: Integer; const ALines:
+      TStringList; const APreviousCharLineIndex, APreviousCharIndex, ANextCharLineIndex, ANextCharIndex: Integer);
   public
-    constructor Create;
+    property CurrentFormation: TRoundRockFormation read FFormation;
+    constructor Create(const ALines: TStringList);
     destructor Destroy; override;
-    procedure Add(const ALine: string);
-    procedure Spin;
-    function CalcWeight: Integer;
+    procedure TiltNorth;
+    procedure TiltWest;
+    procedure TiltSouth;
+    procedure TiltEast;
+    procedure WriteLnFormation;
+    procedure WriteLnIntervals;
   end;
 
   { TParabolicReflectorDish }
 
   TParabolicReflectorDish = class(TSolver)
   private
-    FLineIndex: Integer;
-    FActivePiles, FFinishedPiles: TRockPiles;
-    FPlatform: TPlatform;
+    FLines: TStringList;
   public
     constructor Create;
     destructor Destroy; override;
@@ -84,205 +100,335 @@ type
 
 implementation
 
-{ TRockPile }
+{ TRoundRockFormation }
 
-constructor TRockPile.Create(const AStart: Integer);
-begin
-  FStart := AStart;
-  FLength := 0;
-end;
-
-procedure TRockPile.AddRock;
-begin
-  Inc(FLength);
-end;
-
-function TRockPile.Any: Boolean;
-begin
-  Result := (FLength > 0);
-end;
-
-procedure TRockPile.SetStart(const AStart: Integer);
-begin
-  FStart := AStart;
-end;
-
-function TRockPile.CalcWeight(const ALineCount: Integer): Integer;
-begin
-  Result := FLength * (2 * (ALineCount - FStart) - FLength + 1) div 2;
-end;
-
-{ TPlatform }
-
-procedure TPlatform.TiltNorth;
-var
-  i, j, k: Integer;
-begin
-  for i := 0 to FLines.Count - 1 do
-    for j := 1 to Length(FLines[i]) do
-      if FLines[i][j] = CRoundRockChar then
-      begin
-        k := i - 1;
-        while (k >= 0) and (FLines[k][j] = CEmptyChar) do
-          Dec(k);
-        Inc(k);
-        if k < i then
-          SwapRockLocation(j, i, k);
-      end;
-end;
-
-procedure TPlatform.TiltSouth;
-var
-  i, j, k: Integer;
-begin
-  for i := FLines.Count - 1 downto 0 do
-    for j := 1 to Length(FLines[i]) do
-      if FLines[i][j] = CRoundRockChar then
-      begin
-        k := i + 1;
-        while (k < FLines.Count) and (FLines[k][j] = CEmptyChar) do
-          Inc(k);
-        Dec(k);
-        if k > i then
-          SwapRockLocation(j, i, k);
-      end;
-end;
-
-procedure TPlatform.TiltWest;
-var
-  i, j, k: Integer;
-  s: string;
-begin
-  for i := 0 to FLines.Count - 1 do
-  begin
-    s := FLines[i];
-    k := 1;
-    for j := 1 to Length(s) do
-    begin
-      case s[j] of
-        CEmptyChar:
-          if k <= 0 then
-            k := j;
-        CRoundRockChar: begin
-          if (k > 0) and (k < j) then
-          begin
-            s[k] := CRoundRockChar;
-            s[j] := CEmptyChar;
-            Inc(k);
-          end
-          else
-            k := 0;
-        end;
-        CCubeRockChar: k := 0;
-      end;
-    end;
-    FLines[i] := s;
-  end;
-end;
-
-procedure TPlatform.TiltEast;
-var
-  i, j, k: Integer;
-  s: string;
-begin
-  for i := 0 to FLines.Count - 1 do
-  begin
-    s := FLines[i];
-    k := Length(s) + 1;
-    for j := Length(s) downto 1 do
-    begin
-      case s[j] of
-        CEmptyChar:
-          if k > Length(s) then
-            k := j;
-        CRoundRockChar: begin
-          if (k <= Length(s)) and (j < k) then
-          begin
-            s[k] := CRoundRockChar;
-            s[j] := CEmptyChar;
-            Dec(k);
-          end
-          else
-            k := Length(s) + 1;
-        end;
-        CCubeRockChar: k := Length(s) + 1;
-      end;
-    end;
-    FLines[i] := s;
-  end;
-end;
-
-function TPlatform.IsEqualTo(const FOther: TStringList): Boolean;
+constructor TRoundRockFormation.Create(const AWidth, AHeight: Integer);
 var
   i: Integer;
 begin
-  if FLines.Count = FOther.Count then
+  FColumns := TIntegersList.Create;
+  FColumns.Count := AWidth;
+  for i := 0 to FColumns.Count - 1 do
+    FColumns[i] := TIntegers.Create;
+
+  FRows := TIntegersList.Create;
+  FRows.Count := AHeight;
+  for i := 0 to FRows.Count - 1 do
+    FRows[i] := TIntegers.Create;
+end;
+
+destructor TRoundRockFormation.Destroy;
+begin
+  FColumns.Free;
+  FRows.Free;
+  inherited Destroy;
+end;
+
+procedure TRoundRockFormation.AddRock(const AColumn, ARow: Integer);
+begin
+  FColumns[AColumn].Add(ARow);
+end;
+
+function TRoundRockFormation.CalcWeight: Integer;
+var
+  i, j: Integer;
+begin
+  Result := 0;
+
+  for i := 0 to FColumns.Count - 1 do
+    for j := 0 to FColumns[i].Count - 1 do
+      Inc(Result, FRows.Count - FColumns[i][j]);
+
+  for i := 0 to FRows.Count - 1 do
+    Inc(Result, (FRows.Count - i) * FRows[i].Count);
+end;
+
+function TRoundRockFormation.IsEqualTo(const AOther: TRoundRockFormation): Boolean;
+var
+  i, j: Integer;
+begin
+  Result := (FColumns.Count = AOther.FColumns.Count) and (FRows.Count = AOther.FRows.Count);
+  if not Result then
+    Exit;
+
+  for i := 0 to FColumns.Count - 1 do
   begin
-    Result := True;
-    for i := 0 to FLines.Count - 1 do
-      if FLines[i] <> FOther[i] then
+    if FColumns[i].Count <> AOther.FColumns[i].Count then
+    begin
+      Result := False;
+      Exit;
+    end;
+
+    for j := 0 to FColumns[i].Count - 1 do
+      if FColumns[i][j] <> AOther.FColumns[i][j] then
       begin
         Result := False;
         Exit;
       end;
-  end
-  else
-    Result := False;
+  end;
+
+  for i := 0 to FRows.Count - 1 do
+  begin
+    if FRows[i].Count <> AOther.FRows[i].Count then
+    begin
+      Result := False;
+      Exit;
+    end;
+
+    for j := 0 to FRows[i].Count - 1 do
+      if FRows[i][j] <> AOther.FRows[i][j] then
+      begin
+        Result := False;
+        Exit;
+      end;
+  end;
 end;
 
-procedure TPlatform.SwapRockLocation(const AColumn, ARockLineIndex, AEmptyLineIndex: Integer);
+function TRoundRockFormation.Clone: TRoundRockFormation;
 var
-  s: string;
+  i, rock: Integer;
 begin
-  s := FLines[ARockLineIndex];
-  s[AColumn] := CEmptyChar;
-  FLines[ARockLineIndex] := s;
-  s := FLines[AEmptyLineIndex];
-  s[AColumn] := CRoundRockChar;
-  FLines[AEmptyLineIndex] := s;
+  Result := TRoundRockFormation.Create(FColumns.Count, FRows.Count);
+
+  for i := 0 to FColumns.Count - 1 do
+    for rock in FColumns[i] do
+      Result.FColumns[i].Add(rock);
+
+  for i := 0 to FRows.Count - 1 do
+    for rock in FRows[i] do
+      Result.FRows[i].Add(rock);
 end;
 
-constructor TPlatform.Create;
+{ TPlatform }
+
+procedure TPlatform.Tilt(constref AIntervals: TCubeRockIntervalsList; constref ASource, ATarget:
+  TIntegersList; const AUp: Boolean);
+var
+  i, rock, nextFree, step: Integer;
+  interval: TCubeRockInterval;
+begin
+  if AUp then
+    step := 1
+  else
+    step := -1;
+  for i := 0 to AIntervals.Count - 1 do
+  begin
+    for interval in AIntervals[i] do
+    begin
+      if AUp then
+        nextFree := interval.Start
+      else
+        nextFree := interval.Stop;
+      for rock in ASource[i] do
+        if (interval.Start <= rock) and (rock <= interval.Stop) then
+        begin
+          ATarget[nextFree].Add(i);
+          Inc(nextFree, step);
+        end;
+    end;
+    ASource[i].Clear;
+  end;
+end;
+
+procedure TPlatform.InitIntervals(var AIntervalsList: TCubeRockIntervalsList; const ACount, ALength: Integer);
+var
+  i: Integer;
+  interval: TCubeRockInterval;
+begin
+  AIntervalsList := TCubeRockIntervalsList.Create;
+  AIntervalsList.Count := ACount;
+  interval.Start := 0;
+  interval.Stop := ALength - 1;
+  for i := 0 to ACount - 1 do
+  begin
+    AIntervalsList[i] := TCubeRockIntervals.Create;
+    AIntervalsList[i].Add(interval);
+  end;
+end;
+
+procedure TPlatform.UpdateIntervals(constref AIntervals: TCubeRockIntervals; const AIndex, AMax: Integer; const ALines:
+  TStringList; const APreviousCharLineIndex, APreviousCharIndex, ANextCharLineIndex, ANextCharIndex: Integer);
+var
+  interval: TCubeRockInterval;
+begin
+  if (AIndex > 0) and (ALines[APreviousCharLineIndex][APreviousCharIndex] <> CCubeRockChar) then
+  begin
+    // Finishes previous interval.
+    interval := AIntervals.Last;
+    interval.Stop := AIndex - 1;
+    AIntervals[AIntervals.Count - 1] := interval;
+  end;
+
+  if (AIntervals.Count = 1) and (AIntervals[0].Start = AIndex) then
+  begin
+    // Shifts first interval if not yet started.
+    interval := AIntervals[0];
+    interval.Start := AIndex + 1;
+    AIntervals[0] := interval;
+  end
+  else if (AIndex < AMax) and (ALines[ANextCharLineIndex][ANextCharIndex] <> CCubeRockChar) then
+  begin
+    // Starts interval.
+    interval.Start := AIndex + 1;
+    interval.Stop := AMax;
+    AIntervals.Add(interval);
+  end;
+end;
+
+constructor TPlatform.Create(const ALines: TStringList);
+var
+  i, j, width: Integer;
+begin
+  width := Length(ALines[0]);
+  FFormation := TRoundRockFormation.Create(width, ALines.Count);
+  InitIntervals(FColumnIntervals, width, ALines.Count);
+  InitIntervals(FRowIntervals, ALines.Count, width);
+
+  for i := 0 to ALines.Count - 1 do
+    for j := 1 to width do
+      case ALines[i][j] of
+        CRoundRockChar: FFormation.AddRock(j - 1, i);
+        CCubeRockChar: begin
+          UpdateIntervals(FRowIntervals[i], j - 1, width - 1, ALines, i, j - 1, i, j + 1);
+          UpdateIntervals(FColumnIntervals[j - 1], i, ALines.Count - 1, ALines, i - 1 , j, i + 1, j);
+        end;
+      end;
+end;
+
+destructor TPlatform.Destroy;
+begin
+  FFormation.Free;
+  FColumnIntervals.Free;
+  FRowIntervals.Free;
+  inherited Destroy;
+end;
+
+procedure TPlatform.TiltNorth;
+begin
+  Tilt(FColumnIntervals, FFormation.Columns, FFormation.Rows, True);
+end;
+
+procedure TPlatform.TiltWest;
+begin
+  Tilt(FRowIntervals, FFormation.Rows, FFormation.Columns, True);
+end;
+
+procedure TPlatform.TiltSouth;
+begin
+  Tilt(FColumnIntervals, FFormation.Columns, FFormation.Rows, False);
+end;
+
+procedure TPlatform.TiltEast;
+begin
+  Tilt(FRowIntervals, FFormation.Rows, FFormation.Columns, False);
+end;
+
+procedure TPlatform.WriteLnFormation;
+var
+  i, j: Integer;
+begin
+  WriteLn;
+  WriteLn('Formation:');
+  WriteLn('  Columns:');
+  for i := 0 to FFormation.FColumns.Count - 1 do
+  begin
+    Write('    ', i, ': ');
+    for j := 0 to FFormation.FColumns[i].Count - 1 do
+    begin
+      Write(FFormation.FColumns[i][j], ' ');
+    end;
+    WriteLn;
+  end;
+  WriteLn('  Rows:');
+  for i := 0 to FFormation.FRows.Count - 1 do
+  begin
+    Write('    ', i, ': ');
+    for j := 0 to FFormation.FRows[i].Count - 1 do
+    begin
+      Write(FFormation.FRows[i][j], ' ');
+    end;
+    WriteLn;
+  end;
+  WriteLn('  Weight: ', FFormation.CalcWeight);
+end;
+
+procedure TPlatform.WriteLnIntervals;
+var
+  i, j: Integer;
+begin
+  WriteLn;
+  WriteLn('Intervals:');
+  WriteLn('  Columns:');
+  for i := 0 to FColumnIntervals.Count - 1 do
+  begin
+    Write('    ', i, ': ');
+    for j := 0 to FColumnIntervals[i].Count - 1 do
+    begin
+      Write(FColumnIntervals[i][j].Start, '-', FColumnIntervals[i][j].Stop, ' ');
+    end;
+    WriteLn;
+  end;
+  WriteLn('  Rows:');
+  for i := 0 to FRowIntervals.Count - 1 do
+  begin
+    Write('    ', i, ': ');
+    for j := 0 to FRowIntervals[i].Count - 1 do
+    begin
+      Write(FRowIntervals[i][j].Start, '-', FRowIntervals[i][j].Stop, ' ');
+    end;
+    WriteLn;
+  end;
+end;
+
+{ TParabolicReflectorDish }
+
+constructor TParabolicReflectorDish.Create;
 begin
   FLines := TStringList.Create;
 end;
 
-destructor TPlatform.Destroy;
+destructor TParabolicReflectorDish.Destroy;
 begin
   FLines.Free;
   inherited Destroy;
 end;
 
-procedure TPlatform.Add(const ALine: string);
+procedure TParabolicReflectorDish.ProcessDataLine(const ALine: string);
 begin
   FLines.Add(ALine);
 end;
 
-procedure TPlatform.Spin;
+procedure TParabolicReflectorDish.Finish;
 var
+  platform: TPlatform;
+  history: TRoundRockFormations;
   i, j, x: Integer;
   match: Boolean;
-  history: specialize TObjectList<TStringList>;
 begin
-  // Intializes history of platform rock configurations.
-  history := specialize TObjectList<TStringList>.Create;
-  history.Add(TStringList.Create);
-  history[0].AddStrings(FLines);
+  // Initializes platform.
+  platform := TPlatform.Create(FLines);
 
-  // Performs spins until a configuration from the history is encountered again.
+  // Intializes history of platform rock formation.
+  history := TRoundRockFormations.Create;
+  history.Add(platform.CurrentFormation.Clone);
+
+  // Performs spins until a rock formation from the history is encountered again.
   for i := 1 to CMaxSpinCount do
   begin
-    TiltNorth;
-    TiltWest;
-    TiltSouth;
-    TiltEast;
+    platform.TiltNorth;
+    if FPart1 = 0 then
+      FPart1 := platform.CurrentFormation.CalcWeight;
+    platform.TiltWest;
+    platform.TiltSouth;
+    platform.TiltEast;
 
-    // Searches history for the current configuration.
+    // Searches history for the current rock formation.
     j := 0;
     match := False;
-    while (j < history.Count) and not match do
+    // history.Count - 1 because current rock formation will never be equal to the last one.
+    while (j < history.Count - 1) and not match do
     begin
-      match := IsEqualTo(history[j]);
+      match := platform.CurrentFormation.IsEqualTo(history[j]);
       if not match then
         Inc(j);
     end;
@@ -292,97 +438,16 @@ begin
       x := CMaxSpinCount mod (i - j);
       while x < j do
         Inc(x, i - j);
-      FLines.Free;
-      FLines := history.ExtractIndex(x);
+      FPart2 := history[x].CalcWeight;
       Break;
     end
     else begin
-      history.Add(TStringList.Create);
-      history[i].AddStrings(FLines);
+      history.Add(platform.CurrentFormation.Clone);
     end;
   end;
+
   history.Free;
-end;
-
-function TPlatform.CalcWeight: Integer;
-var
-  i, j, len, count: Integer;
-begin
-  Result := 0;
-  len := Length(FLines[0]);
-  for i := 0 to FLines.Count - 1 do
-  begin
-    count := 0;
-    for j := 1 to len do
-      if FLines[i][j] = CRoundRockChar then
-        Inc(count);
-    Inc(Result, count * (FLines.Count - i));
-  end;
-end;
-
-{ TParabolicReflectorDish }
-
-constructor TParabolicReflectorDish.Create;
-begin
-  FLineIndex := 0;
-  FActivePiles := TRockPiles.Create;
-  FFinishedPiles := TRockPiles.Create;
-  FPlatform := TPlatform.Create;
-end;
-
-destructor TParabolicReflectorDish.Destroy;
-begin
-  FActivePiles.Free;
-  FFinishedPiles.Free;
-  FPlatform.Free;
-  inherited Destroy;
-end;
-
-procedure TParabolicReflectorDish.ProcessDataLine(const ALine: string);
-var
-  i: Integer;
-begin
-  Inc(FLineIndex);
-
-  // Initializes the list of active piles, one per column.
-  if FActivePiles.Count = 0 then
-  begin
-    FActivePiles.Count := Length(ALine);
-    for i:= 0 to FActivePiles.Count - 1 do
-      FActivePiles[i] := TRockPile.Create(0);
-  end;
-
-  // Updates the active piles from the current line.
-  for i := 1 to Length(ALine) do
-  begin
-    case ALine[i] of
-      CRoundRockChar: FActivePiles[i - 1].AddRock;
-      CCubeRockChar:
-        if FActivePiles[i - 1].Any then
-        begin
-          FFinishedPiles.Add(FActivePiles.ExtractIndex(i - 1));
-          FActivePiles.Insert(i - 1, TRockPile.Create(FLineIndex));
-        end
-        else
-          FActivePiles[i - 1].SetStart(FLineIndex);
-    end;
-  end;
-
-  FPlatform.Add(ALine);
-end;
-
-procedure TParabolicReflectorDish.Finish;
-var
-  pile: TRockPile;
-begin
-  for pile in FFinishedPiles do
-    Inc(FPart1, pile.CalcWeight(FLineIndex));
-  for pile in FActivePiles do
-    Inc(FPart1, pile.CalcWeight(FLineIndex));
-
-  // Spins the platform and weighs the rocks.
-  FPlatform.Spin;
-  FPart2 := FPlatform.CalcWeight;
+  platform.Free;
 end;
 
 function TParabolicReflectorDish.GetDataFileName: string;