Added solution for "Day 24: Never Tell Me The Odds", part 1

This commit is contained in:
Stefan Müller 2023-12-26 18:29:05 +01:00 committed by Stefan Müller
parent 5495b32692
commit fb3f41a6af
6 changed files with 313 additions and 2 deletions

View File

@ -133,6 +133,10 @@
<Filename Value="solvers\ULongWalk.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="solvers\UNeverTellMeTheOdds.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>

View File

@ -27,7 +27,7 @@ uses
UTrebuchet, UCubeConundrum, UGearRatios, UScratchcards, UGiveSeedFertilizer, UWaitForIt, UCamelCards,
UHauntedWasteland, UNumberTheory, UMirageMaintenance, UPipeMaze, UCosmicExpansion, UHotSprings, UPointOfIncidence,
UParabolicReflectorDish, ULensLibrary, UFloorWillBeLava, UClumsyCrucible, ULavaductLagoon, UAplenty,
UPulsePropagation, UStepCounter, USandSlabs, ULongWalk;
UPulsePropagation, UStepCounter, USandSlabs, ULongWalk, UNeverTellMeTheOdds;
type
@ -92,6 +92,7 @@ begin
21: engine.RunAndFree(TStepCounter.Create);
22: engine.RunAndFree(TSandSlabs.Create);
23: engine.RunAndFree(TLongWalk.Create);
24: engine.RunAndFree(TNeverTellMeTheOdds.Create);
end;
engine.Free;

View File

@ -0,0 +1,128 @@
{
Solutions to the Advent Of Code.
Copyright (C) 2023 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 UNeverTellMeTheOdds;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Generics.Collections, Math, USolver;
type
{ THailstone }
THailstone = record
X, Y, Z: Int64;
VX, VY, VZ: Integer;
end;
THailstones = specialize TList<THailstone>;
{ TNeverTellMeTheOdds }
TNeverTellMeTheOdds = class(TSolver)
private
FMin, FMax: Int64;
FHailStones: THailstones;
function AreIntersecting(constref AHailstone1, AHailstone2: THailstone): Boolean;
public
constructor Create(const AMin: Int64 = 200000000000000; const AMax: Int64 = 400000000000000);
destructor Destroy; override;
procedure ProcessDataLine(const ALine: string); override;
procedure Finish; override;
function GetDataFileName: string; override;
function GetPuzzleName: string; override;
end;
implementation
{ TNeverTellMeTheOdds }
function TNeverTellMeTheOdds.AreIntersecting(constref AHailstone1, AHailstone2: THailstone): Boolean;
var
m1, m2, x, y: Double;
begin
Result := False;
m1 := AHailstone1.VY / AHailstone1.VX;
m2 := AHailstone2.VY / AHailstone2.VX;
if m1 <> m2 then
begin
x := (AHailstone2.Y - m2 * AHailstone2.X - AHailstone1.Y + m1 * AHailstone1.X) / (m1 - m2);
if (FMin <= x) and (x <= FMax)
and (x * Sign(AHailstone1.VX) >= AHailstone1.X * Sign(AHailstone1.VX))
and (x * Sign(AHailstone2.VX) >= AHailstone2.X * Sign(AHailstone2.VX)) then
begin
y := m1 * (x - AHailstone1.X) + AHailstone1.Y;
if (FMin <= y) and (y <= FMax) then
Result := True
end;
end;
end;
constructor TNeverTellMeTheOdds.Create(const AMin: Int64; const AMax: Int64);
begin
FMin := AMin;
FMax := AMax;
FHailStones := THailstones.Create;
end;
destructor TNeverTellMeTheOdds.Destroy;
begin
FHailStones.Free;
inherited Destroy;
end;
procedure TNeverTellMeTheOdds.ProcessDataLine(const ALine: string);
var
split: TStringArray;
hailstone: THailstone;
begin
split := ALine.Split([',', '@']);
hailstone.X := StrToInt64(Trim(split[0]));
hailstone.Y := StrToInt64(Trim(split[1]));
hailstone.Z := StrToInt64(Trim(split[2]));
hailstone.VX := StrToInt(Trim(split[3]));
hailstone.VY := StrToInt(Trim(split[4]));
hailstone.VZ := StrToInt(Trim(split[5]));
FHailStones.Add(hailstone);
end;
procedure TNeverTellMeTheOdds.Finish;
var
i, j: Integer;
begin
for i := 0 to FHailStones.Count - 2 do
for j := i + 1 to FHailStones.Count - 1 do
if AreIntersecting(FHailStones[i], FHailStones[j]) then
Inc(FPart1);
end;
function TNeverTellMeTheOdds.GetDataFileName: string;
begin
Result := 'never_tell_me_the_odds.txt';
end;
function TNeverTellMeTheOdds.GetPuzzleName: string;
begin
Result := 'Day 24: Never Tell Me The Odds';
end;
end.

View File

@ -136,6 +136,10 @@
<Filename Value="ULongWalkTestCases.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="UNeverTellMeTheOddsTestCases.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>

View File

@ -8,7 +8,8 @@ uses
UHauntedWastelandTestCases, UMirageMaintenanceTestCases, UPipeMazeTestCases, UCosmicExpansionTestCases,
UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases,
UFloorWillBeLavaTestCases, UClumsyCrucibleTestCases, ULavaductLagoonTestCases, UAplentyTestCases,
UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases, ULongWalkTestCases;
UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases, ULongWalkTestCases,
UNeverTellMeTheOddsTestCases;
{$R *.res}

View File

@ -0,0 +1,173 @@
{
Solutions to the Advent Of Code.
Copyright (C) 2023 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 UNeverTellMeTheOddsTestCases;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry, USolver, UBaseTestCases, UNeverTellMeTheOdds;
type
{ TNeverTellMeTheOddsFullDataTestCase }
TNeverTellMeTheOddsFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
{ TNeverTellMeTheOddsExampleTestCase }
TNeverTellMeTheOddsExampleTestCase = class(TExampleEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
{ TNeverTellMeTheOddsTestCase }
TNeverTellMeTheOddsTestCase = class(TSolverTestCase)
protected
function CreateSolver: ISolver; override;
procedure TestTwoLines(const ALine1, ALine2: string);
published
procedure TestExampleLines12;
procedure TestExampleLines13;
procedure TestExampleLines14;
procedure TestExampleLines15;
procedure TestExampleLines23;
procedure TestExampleLines24;
procedure TestExampleLines25;
procedure TestExampleLines34;
procedure TestExampleLines35;
procedure TestExampleLines45;
end;
implementation
{ TNeverTellMeTheOddsFullDataTestCase }
function TNeverTellMeTheOddsFullDataTestCase.CreateSolver: ISolver;
begin
Result := TNeverTellMeTheOdds.Create;
end;
procedure TNeverTellMeTheOddsFullDataTestCase.TestPart1;
begin
AssertEquals(15107, FSolver.GetResultPart1);
end;
{ TNeverTellMeTheOddsExampleTestCase }
function TNeverTellMeTheOddsExampleTestCase.CreateSolver: ISolver;
begin
Result := TNeverTellMeTheOdds.Create(7, 27);
end;
procedure TNeverTellMeTheOddsExampleTestCase.TestPart1;
begin
AssertEquals(2, FSolver.GetResultPart1);
end;
{ TNeverTellMeTheOddsTestCase }
function TNeverTellMeTheOddsTestCase.CreateSolver: ISolver;
begin
Result := TNeverTellMeTheOdds.Create(7, 27);
end;
procedure TNeverTellMeTheOddsTestCase.TestTwoLines(const ALine1, ALine2: string);
begin
FSolver.Init;
FSolver.ProcessDataLine(ALine1);
FSolver.ProcessDataLine(ALine2);
FSolver.Finish;
end;
procedure TNeverTellMeTheOddsTestCase.TestExampleLines12;
begin
TestTwoLines('19, 13, 30 @ -2, 1, -2', '18, 19, 22 @ -1, -1, -2');
AssertEquals(1, FSolver.GetResultPart1);
end;
procedure TNeverTellMeTheOddsTestCase.TestExampleLines13;
begin
TestTwoLines('19, 13, 30 @ -2, 1, -2', '20, 25, 34 @ -2, -2, -4');
AssertEquals(1, FSolver.GetResultPart1);
end;
procedure TNeverTellMeTheOddsTestCase.TestExampleLines14;
begin
TestTwoLines('19, 13, 30 @ -2, 1, -2', '12, 31, 28 @ -1, -2, -1');
AssertEquals(0, FSolver.GetResultPart1);
end;
procedure TNeverTellMeTheOddsTestCase.TestExampleLines15;
begin
TestTwoLines('19, 13, 30 @ -2, 1, -2', '20, 19, 15 @ 1, -5, -3');
AssertEquals(0, FSolver.GetResultPart1);
end;
procedure TNeverTellMeTheOddsTestCase.TestExampleLines23;
begin
TestTwoLines('18, 19, 22 @ -1, -1, -2', '20, 25, 34 @ -2, -2, -4');
AssertEquals(0, FSolver.GetResultPart1);
end;
procedure TNeverTellMeTheOddsTestCase.TestExampleLines24;
begin
TestTwoLines('18, 19, 22 @ -1, -1, -2', '12, 31, 28 @ -1, -2, -1');
AssertEquals(0, FSolver.GetResultPart1);
end;
procedure TNeverTellMeTheOddsTestCase.TestExampleLines25;
begin
TestTwoLines('18, 19, 22 @ -1, -1, -2', '20, 19, 15 @ 1, -5, -3');
AssertEquals(0, FSolver.GetResultPart1);
end;
procedure TNeverTellMeTheOddsTestCase.TestExampleLines34;
begin
TestTwoLines('20, 25, 34 @ -2, -2, -4', '12, 31, 28 @ -1, -2, -1');
AssertEquals(0, FSolver.GetResultPart1);
end;
procedure TNeverTellMeTheOddsTestCase.TestExampleLines35;
begin
TestTwoLines('20, 25, 34 @ -2, -2, -4', '20, 19, 15 @ 1, -5, -3');
AssertEquals(0, FSolver.GetResultPart1);
end;
procedure TNeverTellMeTheOddsTestCase.TestExampleLines45;
begin
TestTwoLines('12, 31, 28 @ -1, -2, -1', '20, 19, 15 @ 1, -5, -3');
AssertEquals(0, FSolver.GetResultPart1);
end;
initialization
RegisterTest(TNeverTellMeTheOddsFullDataTestCase);
RegisterTest(TNeverTellMeTheOddsExampleTestCase);
RegisterTest(TNeverTellMeTheOddsTestCase);
end.