Added caching of calculated combinations per block for day 12

solvers/UHotSprings.pas

@@ -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;
 
       // 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);
-    end;
       damageToValidationAssignments.Free;
+
+      ABlock.CombinationsCache.Add(validationsId, Result);
+    end;
   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;