Added solution for "Day 12: Hot Springs", part 1

This commit is contained in:
Stefan Müller 2023-12-12 15:47:58 +01:00 committed by Stefan Müller
parent 8b13ad992b
commit 64eeb98e85
6 changed files with 321 additions and 2 deletions

View File

@ -81,6 +81,10 @@
<Filename Value="solvers\UCosmicExpansion.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="solvers\UHotSprings.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>

View File

@ -26,7 +26,7 @@ uses
Classes, SysUtils, CustApp,
USolver,
UTrebuchet, UCubeConundrum, UGearRatios, UScratchcards, UGiveSeedFertilizer, UWaitForIt, UCamelCards,
UHauntedWasteland, UNumberTheory, UMirageMaintenance, UPipeMaze, UCosmicExpansion;
UHauntedWasteland, UNumberTheory, UMirageMaintenance, UPipeMaze, UCosmicExpansion, UHotSprings;
type
@ -62,6 +62,7 @@ begin
engine.RunAndFree(TMirageMaintenance.Create);
engine.RunAndFree(TPipeMaze.Create);
engine.RunAndFree(TCosmicExpansion.Create);
engine.RunAndFree(THotSprings.Create);
engine.Free;
end;

170
solvers/UHotSprings.pas Normal file
View File

@ -0,0 +1,170 @@
{
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 UHotSprings;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Generics.Collections, USolver;
const
COperationalChar = '.';
CDamagedChar = '#';
CWildcardChar = '?';
COperationalPatternChars = [COperationalChar, CWildcardChar];
CDamagedPatternChars = [CDamagedChar, CWildcardChar];
type
{ THotSprings }
THotSprings = class(TSolver)
private
FValidation: specialize TList<Integer>;
FSpringPattern: string;
procedure ExtendArrangement(const AArrangement: string; const ARemainingFreeOperationalCount, ACurrentValidationIndex:
Integer);
function TryAppendOperationalChar(var AArrangement: string): Boolean;
function TryAppendValidationBlock(var AArrangement: string; const ALength: Integer): Boolean;
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
{ THotSprings }
procedure THotSprings.ExtendArrangement(const AArrangement: string; const ARemainingFreeOperationalCount,
ACurrentValidationIndex: Integer);
var
i, len: Integer;
match: Boolean;
temp: string;
begin
len := Length(AArrangement);
if len = Length(FSpringPattern) then
Inc(FPart1)
else begin
temp := AArrangement;
// Tries to append a dot (operational) to the current arrangement.
if (ARemainingFreeOperationalCount > 0) and TryAppendOperationalChar(temp) then
begin
ExtendArrangement(temp, ARemainingFreeOperationalCount - 1, ACurrentValidationIndex);
end;
// Tries to append the current validation block (damaged) to the current arrangement.
if ACurrentValidationIndex < FValidation.Count then
begin
temp := AArrangement;
match := TryAppendValidationBlock(temp, FValidation[ACurrentValidationIndex]);
// ... and the mandatory dot after the block, if it is not the last block.
if match
and (ACurrentValidationIndex < FValidation.Count - 1)
and not TryAppendOperationalChar(temp) then
match := False;
if match then
ExtendArrangement(temp, ARemainingFreeOperationalCount, ACurrentValidationIndex + 1);
end;
end;
end;
function THotSprings.TryAppendOperationalChar(var AArrangement: string): Boolean;
begin
if FSpringPattern[Length(AArrangement) + 1] in COperationalPatternChars then
begin
AArrangement := AArrangement + COperationalChar;
Result := True;
end
else
Result := False;
end;
function THotSprings.TryAppendValidationBlock(var AArrangement: string; const ALength: Integer): Boolean;
var
i, len: Integer;
begin
Result := True;
len := Length(AArrangement);
for i := 1 to ALength do
begin
if FSpringPattern[len + i] in CDamagedPatternChars then
AArrangement := AArrangement + CDamagedChar
else begin
Result := False;
Break;
end;
end;
end;
constructor THotSprings.Create;
begin
FValidation := specialize TList<Integer>.Create;
end;
destructor THotSprings.Destroy;
begin
FValidation.Free;
inherited Destroy;
end;
procedure THotSprings.ProcessDataLine(const ALine: string);
var
split: TStringArray;
i, val, maxFreeOperationalCount: Integer;
begin
FValidation.Clear;
split := ALine.Split([' ', ',']);
FSpringPattern := split[0];
maxFreeOperationalCount := Length(FSpringPattern) - Length(split) + 2;
for i := 1 to Length(split) - 1 do
begin
val := StrToInt(split[i]);
FValidation.Add(val);
Dec(maxFreeOperationalCount, val);
end;
ExtendArrangement('', maxFreeOperationalCount, 0);
end;
procedure THotSprings.Finish;
begin
end;
function THotSprings.GetDataFileName: string;
begin
Result := 'hot_springs.txt';
end;
function THotSprings.GetPuzzleName: string;
begin
Result := 'Day 12: Hot Springs';
end;
end.

View File

@ -88,6 +88,10 @@
<Filename Value="UCosmicExpansionTestCases.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="UHotSpringsTestCases.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>

View File

@ -5,7 +5,8 @@ program AdventOfCodeFPCUnit;
uses
Interfaces, Forms, GuiTestRunner, USolver, UBaseTestCases, UTrebuchetTestCases, UCubeConundrumTestCases,
UGearRatiosTestCases, UScratchcardsTestCases, UGiveSeedFertilizerTestCases, UWaitForItTestCases, UCamelCardsTestCases,
UHauntedWastelandTestCases, UMirageMaintenanceTestCases, UPipeMazeTestCases, UCosmicExpansionTestCases;
UHauntedWastelandTestCases, UMirageMaintenanceTestCases, UPipeMazeTestCases, UCosmicExpansionTestCases,
UHotSpringsTestCases;
{$R *.res}

View File

@ -0,0 +1,139 @@
{
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 UHotSpringsTestCases;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry, USolver, UBaseTestCases, UHotSprings;
type
{ THotSpringsFullDataTestCase }
THotSpringsFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
{ THotSpringsExampleTestCase }
THotSpringsExampleTestCase = class(TExampleEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
{ THotSpringsTestCase }
THotSpringsTestCase = class(TSolverTestCase)
protected
function CreateSolver: ISolver; override;
procedure TestSingleLine(const ALine: string; const AValue: Integer);
published
procedure TestExampleLine1;
procedure TestExampleLine2;
procedure TestExampleLine3;
procedure TestExampleLine4;
procedure TestExampleLine5;
procedure TestExampleLine6;
end;
implementation
{ THotSpringsFullDataTestCase }
function THotSpringsFullDataTestCase.CreateSolver: ISolver;
begin
Result := THotSprings.Create;
end;
procedure THotSpringsFullDataTestCase.TestPart1;
begin
AssertEquals(7344, FSolver.GetResultPart1);
end;
{ THotSpringsExampleTestCase }
function THotSpringsExampleTestCase.CreateSolver: ISolver;
begin
Result := THotSprings.Create;
end;
procedure THotSpringsExampleTestCase.TestPart1;
begin
AssertEquals(21, FSolver.GetResultPart1);
end;
{ THotSpringsTestCase }
function THotSpringsTestCase.CreateSolver: ISolver;
begin
Result := THotSprings.Create;
end;
procedure THotSpringsTestCase.TestSingleLine(const ALine: string; const AValue: Integer);
begin
FSolver.Init;
FSolver.ProcessDataLine(ALine);
FSolver.Finish;
AssertEquals(AValue, FSolver.GetResultPart1);
end;
procedure THotSpringsTestCase.TestExampleLine1;
begin
TestSingleLine('???.### 1,1,3', 1);
end;
procedure THotSpringsTestCase.TestExampleLine2;
begin
TestSingleLine('.??..??...?##. 1,1,3', 4);
end;
procedure THotSpringsTestCase.TestExampleLine3;
begin
TestSingleLine('?#?#?#?#?#?#?#? 1,3,1,6', 1);
end;
procedure THotSpringsTestCase.TestExampleLine4;
begin
TestSingleLine('????.#...#... 4,1,1', 1);
end;
procedure THotSpringsTestCase.TestExampleLine5;
begin
TestSingleLine('????.######..#####. 1,6,5', 4);
end;
procedure THotSpringsTestCase.TestExampleLine6;
begin
TestSingleLine('?###???????? 3,2,1', 10);
end;
initialization
RegisterTest(THotSpringsFullDataTestCase);
RegisterTest(THotSpringsExampleTestCase);
RegisterTest(THotSpringsTestCase);
end.