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; + TIntegersList = specialize TObjectList; - { 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; + TCubeRockIntervals = specialize TList; + TCubeRockIntervalsList = specialize TObjectList; + + { 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; { 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; begin - // Intializes history of platform rock configurations. - history := specialize TObjectList.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;