diff --git a/solvers/UHotSprings.pas b/solvers/UHotSprings.pas index 5035ec0..0078c88 100644 --- a/solvers/UHotSprings.pas +++ b/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; + TBlockCombinationsCache = specialize THashMap; + TCombinationsCache = specialize TObjectHashMap; + { 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; @@ -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;