Added solution for "Day 14: Parabolic Reflector Dish", part 2

solvers/UParabolicReflectorDish.pas

@@ -27,6 +27,7 @@ uses
 const
   CRoundRockChar = 'O';
   CCubeRockChar = '#';
+  CMaxSpinCount = 1000000000;
 
 type
 
@@ -45,12 +46,31 @@ type
 
   TRockPiles = specialize TObjectList<TRockPile>;
 
+  { TPlatform }
+
+  TPlatform = class
+  private
+    FLines: TStringList;
+    procedure TiltNorth;
+    procedure TiltSouth;
+    procedure TiltWest;
+    procedure TiltEast;
+    function IsEqualTo(const FOther: TStringList): Boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Add(const ALine: string);
+    procedure Spin;
+    function CalcWeight: Integer;
+  end;
+
   { TParabolicReflectorDish }
 
   TParabolicReflectorDish = class(TSolver)
   private
     FLineIndex: Integer;
     FActivePiles, FFinishedPiles: TRockPiles;
+    FPlatform: TPlatform;
   public
     constructor Create;
     destructor Destroy; override;
@@ -87,7 +107,218 @@ end;
 
 function TRockPile.CalcWeight(const ALineCount: Integer): Integer;
 begin
-  Result := (2 * (ALineCount - FStart) - FLength + 1) * FLength div 2;
+  Result := FLength * (2 * (ALineCount - FStart) - FLength + 1) div 2;
+end;
+
+{ TPlatform }
+
+procedure TPlatform.TiltNorth;
+var
+  i, j, k: Integer;
+  s: string;
+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] = '.') do
+          Dec(k);
+        Inc(k);
+        if k < i then
+        begin
+          s := FLines[i];
+          s[j] := '.';
+          FLines[i] := s;
+          s := FLines[k];
+          s[j] := CRoundRockChar;
+          FLines[k] := s;
+        end;
+      end;
+end;
+
+procedure TPlatform.TiltSouth;
+var
+  i, j, k: Integer;
+  s: string;
+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] = '.') do
+          Inc(k);
+        Dec(k);
+        if k > i then
+        begin
+          s := FLines[i];
+          s[j] := '.';
+          FLines[i] := s;
+          s := FLines[k];
+          s[j] := CRoundRockChar;
+          FLines[k] := s;
+        end;
+      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
+        '.':
+          if k <= 0 then
+            k := j;
+        CRoundRockChar: begin
+          if (k > 0) and (k < j) then
+          begin
+            s[k] := CRoundRockChar;
+            s[j] := '.';
+            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
+        '.':
+          if k > Length(s) then
+            k := j;
+        CRoundRockChar: begin
+          if (k <= Length(s)) and (j < k) then
+          begin
+            s[k] := CRoundRockChar;
+            s[j] := '.';
+            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;
+var
+  i: Integer;
+begin
+  if FLines.Count = FOther.Count then
+  begin
+    Result := True;
+    for i := 0 to FLines.Count - 1 do
+      if FLines[i] <> FOther[i] then
+      begin
+        Result := False;
+        Exit;
+      end;
+  end
+  else
+    Result := False;end;
+
+constructor TPlatform.Create;
+begin
+  FLines := TStringList.Create;
+end;
+
+destructor TPlatform.Destroy;
+begin
+  FLines.Free;
+  inherited Destroy;
+end;
+
+procedure TPlatform.Add(const ALine: string);
+begin
+  FLines.Add(ALine);
+end;
+
+procedure TPlatform.Spin;
+var
+  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);
+
+  // Performs spins until a configuration from the history is encountered again.
+  for i := 1 to CMaxSpinCount do
+  begin
+    TiltNorth;
+    TiltWest;
+    TiltSouth;
+    TiltEast;
+
+    // Searches history for the current configuration.
+    j := 0;
+    match := False;
+    while (j < history.Count) and not match do
+    begin
+      match := IsEqualTo(history[j]);
+      if not match then
+        Inc(j);
+    end;
+
+    if match then
+    begin
+      x := CMaxSpinCount mod (i - j);
+      while x < j do
+        Inc(x, i - j);
+      FLines.Free;
+      FLines := history.ExtractIndex(x);
+      Break;
+    end
+    else begin
+      history.Add(TStringList.Create);
+      history[i].AddStrings(FLines);
+    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 }
@@ -97,12 +328,14 @@ 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;
 
@@ -135,16 +368,22 @@ begin
           FActivePiles[i - 1].SetStart(FLineIndex);
     end;
   end;
+
+  FPlatform.Add(ALine);
 end;
 
 procedure TParabolicReflectorDish.Finish;
 var
-  i: Integer;
+  pile: TRockPile;
 begin
-  for i := 0 to FFinishedPiles.Count - 1 do
-    Inc(FPart1, FFinishedPiles[i].CalcWeight(FLineIndex));
-  for i := 0 to FActivePiles.Count - 1 do
-    Inc(FPart1, FActivePiles[i].CalcWeight(FLineIndex));
+  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;
 end;
 
 function TParabolicReflectorDish.GetDataFileName: string;

tests/UParabolicReflectorDishTestCases.pas

@@ -33,6 +33,7 @@ type
     function CreateSolver: ISolver; override;
   published
     procedure TestPart1;
+    procedure TestPart2;
   end;
 
   { TParabolicReflectorDishExampleTestCase }
@@ -42,6 +43,7 @@ type
     function CreateSolver: ISolver; override;
   published
     procedure TestPart1;
+    procedure TestPart2;
   end;
 
 implementation
@@ -58,6 +60,11 @@ begin
   AssertEquals(103614, FSolver.GetResultPart1);
 end;
 
+procedure TParabolicReflectorDishFullDataTestCase.TestPart2;
+begin
+  AssertEquals(83790, FSolver.GetResultPart2);
+end;
+
 { TParabolicReflectorDishExampleTestCase }
 
 function TParabolicReflectorDishExampleTestCase.CreateSolver: ISolver;
@@ -70,6 +77,11 @@ begin
   AssertEquals(136, FSolver.GetResultPart1);
 end;
 
+procedure TParabolicReflectorDishExampleTestCase.TestPart2;
+begin
+  AssertEquals(64, FSolver.GetResultPart2);
+end;
+
 initialization
 
   RegisterTest(TParabolicReflectorDishFullDataTestCase);