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

View File

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