Added solution for "Day 25: Snowverload", part 1
This commit is contained in:
parent
216839c98b
commit
c5ea70ed21
|
@ -149,6 +149,10 @@
|
||||||
<Filename Value="UPolynomialRoots.pas"/>
|
<Filename Value="UPolynomialRoots.pas"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
</Unit>
|
</Unit>
|
||||||
|
<Unit>
|
||||||
|
<Filename Value="solvers\USnowverload.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit>
|
||||||
</Units>
|
</Units>
|
||||||
</ProjectOptions>
|
</ProjectOptions>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
|
|
|
@ -27,7 +27,7 @@ uses
|
||||||
UTrebuchet, UCubeConundrum, UGearRatios, UScratchcards, UGiveSeedFertilizer, UWaitForIt, UCamelCards,
|
UTrebuchet, UCubeConundrum, UGearRatios, UScratchcards, UGiveSeedFertilizer, UWaitForIt, UCamelCards,
|
||||||
UHauntedWasteland, UMirageMaintenance, UPipeMaze, UCosmicExpansion, UHotSprings, UPointOfIncidence,
|
UHauntedWasteland, UMirageMaintenance, UPipeMaze, UCosmicExpansion, UHotSprings, UPointOfIncidence,
|
||||||
UParabolicReflectorDish, ULensLibrary, UFloorWillBeLava, UClumsyCrucible, ULavaductLagoon, UAplenty,
|
UParabolicReflectorDish, ULensLibrary, UFloorWillBeLava, UClumsyCrucible, ULavaductLagoon, UAplenty,
|
||||||
UPulsePropagation, UStepCounter, USandSlabs, ULongWalk, UNeverTellMeTheOdds;
|
UPulsePropagation, UStepCounter, USandSlabs, ULongWalk, UNeverTellMeTheOdds, USnowverload;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
|
@ -96,6 +96,7 @@ begin
|
||||||
22: engine.RunAndFree(TSandSlabs.Create);
|
22: engine.RunAndFree(TSandSlabs.Create);
|
||||||
23: engine.RunAndFree(TLongWalk.Create);
|
23: engine.RunAndFree(TLongWalk.Create);
|
||||||
24: engine.RunAndFree(TNeverTellMeTheOdds.Create);
|
24: engine.RunAndFree(TNeverTellMeTheOdds.Create);
|
||||||
|
25: engine.RunAndFree(TSnowverload.Create);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
engine.Free;
|
engine.Free;
|
||||||
|
|
|
@ -0,0 +1,324 @@
|
||||||
|
{
|
||||||
|
Solutions to the Advent Of Code.
|
||||||
|
Copyright (C) 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 USnowverload;
|
||||||
|
|
||||||
|
{$mode ObjFPC}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, Generics.Collections, USolver;
|
||||||
|
|
||||||
|
type
|
||||||
|
TSnowComponent = class;
|
||||||
|
TSnowComponents = specialize TObjectList<TSnowComponent>;
|
||||||
|
|
||||||
|
{ TSnowComponent }
|
||||||
|
|
||||||
|
TSnowComponent = class
|
||||||
|
private
|
||||||
|
FName: string;
|
||||||
|
FMergedComponents: TSnowComponents;
|
||||||
|
public
|
||||||
|
property Name: string read FName;
|
||||||
|
procedure AddMerged(constref AMerge: TSnowComponent);
|
||||||
|
function GetMergeCount: Integer;
|
||||||
|
constructor Create(const AName: string);
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TWire }
|
||||||
|
|
||||||
|
TWire = class
|
||||||
|
private
|
||||||
|
FComponent1, FComponent2, FOriginalComponent1, FOriginalComponent2: TSnowComponent;
|
||||||
|
public
|
||||||
|
property Component1: TSnowComponent read FComponent1;
|
||||||
|
property Component2: TSnowComponent read FComponent2;
|
||||||
|
procedure Reattach(constref AOldComponent, ANewComponent: TSnowComponent);
|
||||||
|
function IsLoop: Boolean;
|
||||||
|
procedure Reset;
|
||||||
|
constructor Create(constref AComponent1, AComponent2: TSnowComponent);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TWires = specialize TObjectList<TWire>;
|
||||||
|
|
||||||
|
{ TNetwork }
|
||||||
|
|
||||||
|
TNetwork = class
|
||||||
|
private
|
||||||
|
FComponents: TSnowComponents;
|
||||||
|
FDisconnectableWires, FContractedWires: TWires;
|
||||||
|
public
|
||||||
|
function FindOrCreateComponent(const AName: string): TSnowComponent;
|
||||||
|
procedure AddWire(constref AWire: TWire);
|
||||||
|
function RunMinCutContractionAlgorithm: Integer;
|
||||||
|
procedure Reset;
|
||||||
|
function GetResult: Integer;
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TSnowverload }
|
||||||
|
|
||||||
|
TSnowverload = class(TSolver)
|
||||||
|
private
|
||||||
|
FNetwork: TNetwork;
|
||||||
|
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
|
||||||
|
|
||||||
|
{ TSnowComponent }
|
||||||
|
|
||||||
|
procedure TSnowComponent.AddMerged(constref AMerge: TSnowComponent);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
c: TSnowComponent;
|
||||||
|
begin
|
||||||
|
FMergedComponents.Add(AMerge);
|
||||||
|
i := AMerge.FMergedComponents.Count - 1;
|
||||||
|
while i >= 0 do
|
||||||
|
begin
|
||||||
|
c := AMerge.FMergedComponents.ExtractIndex(i);
|
||||||
|
FMergedComponents.Add(c);
|
||||||
|
Dec(i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TSnowComponent.GetMergeCount: Integer;
|
||||||
|
begin
|
||||||
|
Result := FMergedComponents.Count + 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TSnowComponent.Create(const AName: string);
|
||||||
|
begin
|
||||||
|
FName := AName;
|
||||||
|
FMergedComponents := TSnowComponents.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TSnowComponent.Destroy;
|
||||||
|
begin
|
||||||
|
FMergedComponents.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TWire }
|
||||||
|
|
||||||
|
procedure TWire.Reattach(constref AOldComponent, ANewComponent: TSnowComponent);
|
||||||
|
begin
|
||||||
|
if FComponent1 = AOldComponent then
|
||||||
|
FComponent1 := ANewComponent;
|
||||||
|
if FComponent2 = AOldComponent then
|
||||||
|
FComponent2 := ANewComponent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TWire.IsLoop: Boolean;
|
||||||
|
begin
|
||||||
|
Result := FComponent1 = FComponent2;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TWire.Reset;
|
||||||
|
begin
|
||||||
|
FComponent1 := FOriginalComponent1;
|
||||||
|
FComponent2 := FOriginalComponent2;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TWire.Create(constref AComponent1, AComponent2: TSnowComponent);
|
||||||
|
begin
|
||||||
|
FComponent1 := AComponent1;
|
||||||
|
FComponent2 := AComponent2;
|
||||||
|
FOriginalComponent1 := AComponent1;
|
||||||
|
FOriginalComponent2 := AComponent2;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TNetwork }
|
||||||
|
|
||||||
|
function TNetwork.FindOrCreateComponent(const AName: string): TSnowComponent;
|
||||||
|
var
|
||||||
|
found: Boolean;
|
||||||
|
begin
|
||||||
|
found := False;
|
||||||
|
for Result in FComponents do
|
||||||
|
if Result.Name = AName then
|
||||||
|
begin
|
||||||
|
found := True;
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
if not found then
|
||||||
|
begin
|
||||||
|
Result := TSnowComponent.Create(AName);
|
||||||
|
FComponents.Add(Result);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TNetwork.AddWire(constref AWire: TWire);
|
||||||
|
begin
|
||||||
|
FDisconnectableWires.Add(AWire);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TNetwork.RunMinCutContractionAlgorithm: Integer;
|
||||||
|
var
|
||||||
|
r, i: Integer;
|
||||||
|
contraction, w: TWire;
|
||||||
|
begin
|
||||||
|
while FComponents.Count > 2 do
|
||||||
|
begin
|
||||||
|
// Determines contraction.
|
||||||
|
r := Random(FDisconnectableWires.Count - 1);
|
||||||
|
contraction := FDisconnectableWires.ExtractIndex(r);
|
||||||
|
FContractedWires.Add(contraction);
|
||||||
|
|
||||||
|
// Merges contraction.Component2 into contraction.Component1.
|
||||||
|
contraction.Component1.AddMerged(FComponents.Extract(contraction.Component2));
|
||||||
|
|
||||||
|
// Fix the wires connected to contraction.Component2.
|
||||||
|
i := FDisconnectableWires.Count - 1;
|
||||||
|
while i >= 0 do
|
||||||
|
begin
|
||||||
|
FDisconnectableWires[i].Reattach(contraction.Component2, contraction.Component1);
|
||||||
|
if FDisconnectableWires[i].IsLoop then
|
||||||
|
begin
|
||||||
|
w := FDisconnectableWires.ExtractIndex(i);
|
||||||
|
FContractedWires.Add(w);
|
||||||
|
end;
|
||||||
|
Dec(i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := FDisconnectableWires.Count;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TNetwork.Reset;
|
||||||
|
var
|
||||||
|
i, j: Integer;
|
||||||
|
c: TSnowComponent;
|
||||||
|
w: TWire;
|
||||||
|
begin
|
||||||
|
// Resets the components.
|
||||||
|
i := 0;
|
||||||
|
while i < FComponents.Count do
|
||||||
|
begin
|
||||||
|
j := FComponents[i].FMergedComponents.Count - 1;
|
||||||
|
while j >= 0 do
|
||||||
|
begin
|
||||||
|
c := FComponents[i].FMergedComponents.ExtractIndex(j);
|
||||||
|
FComponents.Add(c);
|
||||||
|
Dec(j);
|
||||||
|
end;
|
||||||
|
Inc(i);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Resets the wires.
|
||||||
|
for w in FDisconnectableWires do
|
||||||
|
w.Reset;
|
||||||
|
i := FContractedWires.Count - 1;
|
||||||
|
while i >= 0 do
|
||||||
|
begin
|
||||||
|
w := FContractedWires.ExtractIndex(i);
|
||||||
|
w.Reset;
|
||||||
|
FDisconnectableWires.Add(w);
|
||||||
|
Dec(i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TNetwork.GetResult: Integer;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
if FComponents.Count = 2 then
|
||||||
|
Result := FComponents[0].GetMergeCount * FComponents[1].GetMergeCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TNetwork.Create;
|
||||||
|
begin
|
||||||
|
FComponents := TSnowComponents.Create;
|
||||||
|
FDisconnectableWires := TWires.Create;
|
||||||
|
FContractedWires := TWires.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TNetwork.Destroy;
|
||||||
|
begin
|
||||||
|
FComponents.Free;
|
||||||
|
FDisconnectableWires.Free;
|
||||||
|
FContractedWires.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TSnowverload }
|
||||||
|
|
||||||
|
constructor TSnowverload.Create;
|
||||||
|
begin
|
||||||
|
FNetwork := TNetwork.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TSnowverload.Destroy;
|
||||||
|
begin
|
||||||
|
FNetwork.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSnowverload.ProcessDataLine(const ALine: string);
|
||||||
|
var
|
||||||
|
split: TStringArray;
|
||||||
|
c1, c2: TSnowComponent;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
split := ALine.Split([':', ' ']);
|
||||||
|
c1 := FNetwork.FindOrCreateComponent(split[0]);
|
||||||
|
for i := 2 to Length(split) - 1 do
|
||||||
|
begin
|
||||||
|
c2 := FNetwork.FindOrCreateComponent(split[i]);
|
||||||
|
FNetwork.AddWire(TWire.Create(c1, c2));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSnowverload.Finish;
|
||||||
|
var
|
||||||
|
cut, count: Integer;
|
||||||
|
begin
|
||||||
|
// Karger's algorithm with known minimum cut size.
|
||||||
|
// See https://en.wikipedia.org/wiki/Karger%27s_algorithm
|
||||||
|
count := 1;
|
||||||
|
cut := FNetwork.RunMinCutContractionAlgorithm;
|
||||||
|
while cut > 3 do
|
||||||
|
begin
|
||||||
|
Inc(count);
|
||||||
|
FNetwork.Reset;
|
||||||
|
cut := FNetwork.RunMinCutContractionAlgorithm;
|
||||||
|
end;
|
||||||
|
FPart1 := FNetwork.GetResult;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TSnowverload.GetDataFileName: string;
|
||||||
|
begin
|
||||||
|
Result := 'snowverload.txt';
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TSnowverload.GetPuzzleName: string;
|
||||||
|
begin
|
||||||
|
Result := 'Day 25: Snowverload';
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
|
@ -148,6 +148,10 @@
|
||||||
<Filename Value="UBigIntTestCases.pas"/>
|
<Filename Value="UBigIntTestCases.pas"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
</Unit>
|
</Unit>
|
||||||
|
<Unit>
|
||||||
|
<Filename Value="USnowverloadTestCases.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit>
|
||||||
</Units>
|
</Units>
|
||||||
</ProjectOptions>
|
</ProjectOptions>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
|
|
|
@ -9,7 +9,8 @@ uses
|
||||||
UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases,
|
UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases,
|
||||||
UFloorWillBeLavaTestCases, UClumsyCrucibleTestCases, ULavaductLagoonTestCases, UAplentyTestCases,
|
UFloorWillBeLavaTestCases, UClumsyCrucibleTestCases, ULavaductLagoonTestCases, UAplentyTestCases,
|
||||||
UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases, ULongWalkTestCases,
|
UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases, ULongWalkTestCases,
|
||||||
UNeverTellMeTheOddsTestCases, UBigIntTestCases, UPolynomialTestCases, UPolynomialRootsTestCases;
|
UNeverTellMeTheOddsTestCases, UBigIntTestCases, UPolynomialTestCases, UPolynomialRootsTestCases,
|
||||||
|
USnowverloadTestCases;
|
||||||
|
|
||||||
{$R *.res}
|
{$R *.res}
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,78 @@
|
||||||
|
{
|
||||||
|
Solutions to the Advent Of Code.
|
||||||
|
Copyright (C) 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 USnowverloadTestCases;
|
||||||
|
|
||||||
|
{$mode ObjFPC}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, fpcunit, testregistry, USolver, UBaseTestCases, USnowverload;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TSnowverloadFullDataTestCase }
|
||||||
|
|
||||||
|
TSnowverloadFullDataTestCase = class(TEngineBaseTest)
|
||||||
|
protected
|
||||||
|
function CreateSolver: ISolver; override;
|
||||||
|
published
|
||||||
|
procedure TestPart1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TSnowverloadExampleTestCase }
|
||||||
|
|
||||||
|
TSnowverloadExampleTestCase = class(TExampleEngineBaseTest)
|
||||||
|
protected
|
||||||
|
function CreateSolver: ISolver; override;
|
||||||
|
published
|
||||||
|
procedure TestPart1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TSnowverloadFullDataTestCase }
|
||||||
|
|
||||||
|
function TSnowverloadFullDataTestCase.CreateSolver: ISolver;
|
||||||
|
begin
|
||||||
|
Result := TSnowverload.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSnowverloadFullDataTestCase.TestPart1;
|
||||||
|
begin
|
||||||
|
AssertEquals(552695, FSolver.GetResultPart1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TSnowverloadExampleTestCase }
|
||||||
|
|
||||||
|
function TSnowverloadExampleTestCase.CreateSolver: ISolver;
|
||||||
|
begin
|
||||||
|
Result := TSnowverload.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSnowverloadExampleTestCase.TestPart1;
|
||||||
|
begin
|
||||||
|
AssertEquals(54, FSolver.GetResultPart1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
|
||||||
|
RegisterTest(TSnowverloadFullDataTestCase);
|
||||||
|
RegisterTest(TSnowverloadExampleTestCase);
|
||||||
|
end.
|
||||||
|
|
Loading…
Reference in New Issue