warrence
/
AdventOfCode2023
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added caching of calculated combinations per block for day 12

This commit is contained in:
Stefan Müller 2024-11-19 22:58:15 +01:00
parent 16e7528b34
commit 2ff41caf37
1 changed files with 49 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

141
solvers/UHotSprings.pas
View File

@ -21,9 +21,6 @@ unit UHotSprings;
interface
// TODO: Remove this and the ifdefs.
{$define debug}
uses
Classes, SysUtils, Math, Generics.Collections, USolver, UCommon, UMultiIndexEnumerator, UBinomialCoefficients;
@ -43,21 +40,26 @@ type
end;
TDamages = specialize TList<TDamage>;
TBlockCombinationsCache = specialize THashMap<Int64, Int64>;
TCombinationsCache = specialize TObjectHashMap<string, TBlockCombinationsCache>;
{ TBlock }
TBlock = class
private
FPattern: string;
FDamages: TDamages;
FCombinationsCache: TBlockCombinationsCache;
procedure ParseDamages;
public
constructor Create(const APattern: string);
constructor Create(const APattern: string; constref ACombinationsCache: TBlockCombinationsCache);
destructor Destroy; override;
property Pattern: string read FPattern;
// List of damages in this block, containing exactly one entry for each sequence of consecutive damage characters in
// the block's pattern, ordered such that a damage with lower index is further left.
// For example, if Pattern is '??##?#?', then Damages would have 2 entries.
property Damages: TDamages read FDamages;
property CombinationsCache: TBlockCombinationsCache read FCombinationsCache;
end;
TBlocks = specialize TObjectList<TBlock>;
@ -164,13 +166,15 @@ type
// Array 'a' of minimum indices 'a[i]', such that all remaining validation numbers starting at index 'a[i] - 1'
// cannot fit into the remaining blocks starting at 'FBlocks[i]'.
FMinIndices: TIndexArray;
FCombinationsCache: TCombinationsCache;
procedure InitValidationLengths;
procedure InitMinIndices;
function CalcCombinationsBlockSingleValidation(constref ABlock: TBlock; const AIndex: Integer): Int64;
function CalcCombinationsBlockMultiValidations(constref ABlock: TBlock; constref AIndices: TIndexArray;
const AStartIndex, AStopIndex: Integer): Int64;
function CalcValidationsId(const AStartIndex, AStopIndex: Integer): Int64;
public
constructor Create;
constructor Create(constref ACombinationsCache: TCombinationsCache);
destructor Destroy; override;
// Adds all non-empty, maximum-length parts of the pattern without operational springs ("blocks").
procedure AddBlocks(const APattern: string);
@ -187,8 +191,7 @@ type
THotSprings = class(TSolver)
private
// TODO: Remove FDebugIndex.
FDebugIndex: Integer;
FCombinationsCache: TCombinationsCache;
public
constructor Create;
destructor Destroy; override;
@ -232,9 +235,10 @@ begin
end;
end;
constructor TBlock.Create(const APattern: string);
constructor TBlock.Create(const APattern: string; constref ACombinationsCache: TBlockCombinationsCache);
begin
FPattern := APattern;
FCombinationsCache := ACombinationsCache;
ParseDamages;
end;
@ -575,13 +579,6 @@ begin
ABlock.Damages[high].Start + ABlock.Damages[high].Length - FValidation[position.ValidationIndex]);
positions.Add(position);
{$ifdef debug}
WriteLn(' validation position infos');
for position in positions do
WriteLn(' ', position.ValidationIndex, ' ', position.MinStart, ' ', position.MaxStart);
WriteLn(' offsets');
{$endif}
Result := 0;
validationPositionOffsets := TValidationPositionOffsets.Create(Self, positions, Length(ABlock.Pattern),
AStartIndex, AStopIndex);
@ -592,10 +589,21 @@ begin
positions.Free;
end;
constructor TConditionRecord.Create;
function TConditionRecord.CalcValidationsId(const AStartIndex, AStopIndex: Integer): Int64;
var
i: Integer;
begin
// Requires 'FValidations[i] < 32' for each 'i' and 'AStopIndex - AStartIndex < 12'.
Result := FValidation[AStartIndex];
for i := AStartIndex + 1 to AStopIndex do
Result := (Result shl 5) or FValidation[i];
end;
constructor TConditionRecord.Create(constref ACombinationsCache: TCombinationsCache);
begin
FBlocks := TBlocks.Create;
FValidation := TIntegerList.Create;
FCombinationsCache := ACombinationsCache;
end;
destructor TConditionRecord.Destroy;
@ -609,11 +617,19 @@ procedure TConditionRecord.AddBlocks(const APattern: string);
var
split: TStringArray;
part: string;
blockCache: TBlockCombinationsCache;
begin
split := APattern.Split([COperationalChar]);
for part in split do
if Length(part) > 0 then
FBlocks.Add(TBlock.Create(part));
begin
if not FCombinationsCache.TryGetValue(part, blockCache) then
begin
blockCache := TBlockCombinationsCache.Create;
FCombinationsCache.Add(part, blockCache);
end;
FBlocks.Add(TBlock.Create(part, blockCache));
end;
end;
function TConditionRecord.GenerateBlockAssignments: Int64;
@ -633,17 +649,10 @@ end;
function TConditionRecord.CalcCombinationsBlock(constref ABlock: TBlock; const AStartIndex, AStopIndex: Integer): Int64;
var
i, j, k: Integer;
validationsId: Int64;
indices: TIndexArray;
damageToValidationAssignments: TDamageToValidationAssignments;
begin
{$ifdef debug}
Write(' ', ABlock.Pattern, ' ');
for i := AStartIndex to AStopIndex do
Write(FValidation[i], ' ');
WriteLn;
{$endif}
// No validation number assigned to this block.
if AStartIndex > AStopIndex then
begin
@ -655,55 +664,21 @@ begin
// One validation number assigned to this block.
else if AStartIndex = AStopIndex then
Result := CalcCombinationsBlockSingleValidation(ABlock, AStartIndex)
// Multiple validation numbers assigned to this block.
// Multiple validation numbers assigned to this block. Checks cache first.
else begin
{$ifdef debug}
Write(' min before: ');
for i := AStartIndex to AStopIndex do
Write(FValidationLengths[AStartIndex, i + 1] - FValidation[i], ' ');
WriteLn;
Write(' min after: ');
for i := AStartIndex to AStopIndex do
Write(FValidationLengths[i, AStopIndex + 1] - FValidation[i], ' ');
WriteLn;
for i := 0 to ABlock.Damages.Count - 1 do
validationsId := CalcValidationsId(AStartIndex, AStopIndex);
if not ABlock.CombinationsCache.TryGetValue(validationsId, Result) then
begin
WriteLn(' damage: start ',ABlock.Damages[i].Start, ', length ', ABlock.Damages[i].Length, ', remain ', ABlock.Damages[i].CharsRemaining);
Write(' ');
for j := AStartIndex to AStopIndex do
// Enough space before damage for the other validation numbers?
if (FValidationLengths[AStartIndex, j + 1] - FValidation[j] < ABlock.Damages[i].Start)
// Enough space after damage for the other validation numbers?
and (FValidationLengths[j, AStopIndex + 1] - FValidation[j] <= ABlock.Damages[i].CharsRemaining)
// Damage itself small enough for this validation number?
and (FValidation[j] >= ABlock.Damages[i].Length) then
Write(j - AStartIndex, ' ');
WriteLn;
end;
{$endif}
Result := 0;
Result := 0;
// Assigns validation numbers to specific damages.
damageToValidationAssignments := TDamageToValidationAssignments.Create(Self, ABlock, AStartIndex, AStopIndex);
for indices in damageToValidationAssignments do
Result := Result + CalcCombinationsBlockMultiValidations(ABlock, indices, AStartIndex, AStopIndex);
damageToValidationAssignments.Free;
// Assigns validation numbers to specific damages.
damageToValidationAssignments := TDamageToValidationAssignments.Create(Self, ABlock, AStartIndex, AStopIndex);
{$ifdef debug}
WriteLn(' validation numbers (indices) per damages:');
{$endif}
for indices in damageToValidationAssignments do
begin
{$ifdef debug}
Write(' ');
for i := 0 to ABlock.Damages.Count - 1 do
Write(FValidation[indices[i]], ' ');
Write('( ');
for i := 0 to ABlock.Damages.Count - 1 do
Write(indices[i] - AStartIndex, ' ');
WriteLn(')');
{$endif}
Result := Result + CalcCombinationsBlockMultiValidations(ABlock, indices, AStartIndex, AStopIndex);
ABlock.CombinationsCache.Add(validationsId, Result);
end;
damageToValidationAssignments.Free;
end;
end;
@ -716,31 +691,25 @@ begin
begin
count := AStopIndex + 1 - AStartIndex;
freedoms := ASequenceLength - FValidationLengths[AStartIndex, AStopIndex + 1];
{$ifdef debug}
Write(count, '/', ASequenceLength, '/', freedoms, ' ');
{$endif}
if freedoms >= 0 then
Result := BinomialCoefficients.Get(count + freedoms, freedoms)
else
Result := 0;
end
else begin
else
Result := 1;
{$ifdef debug}
Write('X ');
{$endif}
end;
end;
{ THotSprings }
constructor THotSprings.Create;
begin
FDebugIndex := 0;
FCombinationsCache := TCombinationsCache.Create([doOwnsValues]);
end;
destructor THotSprings.Destroy;
begin
FCombinationsCache.Free;
inherited Destroy;
end;
@ -751,13 +720,8 @@ var
part, unfolded: string;
i: Integer;
begin
{$ifdef debug}
WriteLn(ALine);
WriteLn;
{$endif}
conditionRecord1 := TConditionRecord.Create;
conditionRecord2 := TConditionRecord.Create;
conditionRecord1 := TConditionRecord.Create(FCombinationsCache);
conditionRecord2 := TConditionRecord.Create(FCombinationsCache);
mainSplit := ALine.Split([' ']);
@ -777,18 +741,11 @@ begin
for i := 1 to CPart2Repetition do
conditionRecord2.Validation.AddRange(conditionRecord1.Validation);
WriteLn(FDebugIndex + 1);
Inc(FDebugIndex);
FPart1 := FPart1 + conditionRecord1.GenerateBlockAssignments;
FPart2 := FPart2 + conditionRecord2.GenerateBlockAssignments;
conditionRecord1.Free;
conditionRecord2.Free;
{$ifdef debug}
WriteLn('------------------------');
WriteLn;
{$endif}
end;
procedure THotSprings.Finish;