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. +