diff --git a/AdventOfCode.lpi b/AdventOfCode.lpi
index 3061d84..2af3826 100644
--- a/AdventOfCode.lpi
+++ b/AdventOfCode.lpi
@@ -149,6 +149,10 @@
+
+
+
+
diff --git a/AdventOfCode.lpr b/AdventOfCode.lpr
index af7a029..ede834a 100644
--- a/AdventOfCode.lpr
+++ b/AdventOfCode.lpr
@@ -27,7 +27,7 @@ uses
UTrebuchet, UCubeConundrum, UGearRatios, UScratchcards, UGiveSeedFertilizer, UWaitForIt, UCamelCards,
UHauntedWasteland, UMirageMaintenance, UPipeMaze, UCosmicExpansion, UHotSprings, UPointOfIncidence,
UParabolicReflectorDish, ULensLibrary, UFloorWillBeLava, UClumsyCrucible, ULavaductLagoon, UAplenty,
- UPulsePropagation, UStepCounter, USandSlabs, ULongWalk, UNeverTellMeTheOdds;
+ UPulsePropagation, UStepCounter, USandSlabs, ULongWalk, UNeverTellMeTheOdds, USnowverload;
type
@@ -96,6 +96,7 @@ begin
22: engine.RunAndFree(TSandSlabs.Create);
23: engine.RunAndFree(TLongWalk.Create);
24: engine.RunAndFree(TNeverTellMeTheOdds.Create);
+ 25: engine.RunAndFree(TSnowverload.Create);
end;
engine.Free;
diff --git a/solvers/USnowverload.pas b/solvers/USnowverload.pas
new file mode 100644
index 0000000..f478564
--- /dev/null
+++ b/solvers/USnowverload.pas
@@ -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 .
+}
+
+unit USnowverload;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Generics.Collections, USolver;
+
+type
+ TSnowComponent = class;
+ TSnowComponents = specialize TObjectList;
+
+ { 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;
+
+ { 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.
+
diff --git a/tests/AdventOfCodeFPCUnit.lpi b/tests/AdventOfCodeFPCUnit.lpi
index e34e993..0d0c019 100644
--- a/tests/AdventOfCodeFPCUnit.lpi
+++ b/tests/AdventOfCodeFPCUnit.lpi
@@ -148,6 +148,10 @@
+
+
+
+
diff --git a/tests/AdventOfCodeFPCUnit.lpr b/tests/AdventOfCodeFPCUnit.lpr
index 27320a1..7d150c4 100644
--- a/tests/AdventOfCodeFPCUnit.lpr
+++ b/tests/AdventOfCodeFPCUnit.lpr
@@ -9,7 +9,8 @@ uses
UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases,
UFloorWillBeLavaTestCases, UClumsyCrucibleTestCases, ULavaductLagoonTestCases, UAplentyTestCases,
UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases, ULongWalkTestCases,
- UNeverTellMeTheOddsTestCases, UBigIntTestCases, UPolynomialTestCases, UPolynomialRootsTestCases;
+ UNeverTellMeTheOddsTestCases, UBigIntTestCases, UPolynomialTestCases, UPolynomialRootsTestCases,
+ USnowverloadTestCases;
{$R *.res}
diff --git a/tests/USnowverloadTestCases.pas b/tests/USnowverloadTestCases.pas
new file mode 100644
index 0000000..0e8d2b9
--- /dev/null
+++ b/tests/USnowverloadTestCases.pas
@@ -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 .
+}
+
+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.
+