Updated day 12 WIP solver (correct solution)

This commit is contained in:
Stefan Müller 2024-11-12 19:16:12 +01:00
parent 60ef49c1ee
commit 1642c7dcfb
1 changed files with 86 additions and 113 deletions

View File

@ -21,6 +21,9 @@ 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;
@ -28,37 +31,17 @@ const
COperationalChar = '.'; COperationalChar = '.';
CDamagedChar = '#'; CDamagedChar = '#';
CWildcardChar = '?'; CWildcardChar = '?';
//COperationalPatternChars = [COperationalChar, CWildcardChar]; CPart2Repetition = 5;
//CDamagedPatternChars = [CDamagedChar, CWildcardChar];
CPart2Repetition = 1;
type type
//{ TBlockAssignment }
//
//TBlockAssignment = class
//private
// FPrevious: TBlockAssignment;
// FPattern: string;
// FValidation: TIntegerList;
//public
// property Validation: TIntegerList read FValidation;
// constructor Create(const APattern: string; constref APrevious: TBlockAssignment = nil);
// destructor Destroy; override;
// procedure WriteDebug;
//end;
//
//TBlockAssignments = specialize TObjectList<TBlockAssignment>;
TValidationLengths = array of array of Integer; TValidationLengths = array of array of Integer;
//TPatternLengths = array of Integer;
// TODO: TIntegerArray probably not needed. // TODO: TIntegerArray probably not needed.
TIntegerArray = array of Integer; TIntegerArray = array of Integer;
{ TDamage } { TDamage }
TDamage = record TDamage = record
Start, Length, CharsRemaining: Byte; Start, Length, CharsRemaining: Integer;
end; end;
TDamages = specialize TList<TDamage>; TDamages = specialize TList<TDamage>;
@ -89,8 +72,7 @@ type
{ TValidationPositionInfo } { TValidationPositionInfo }
TValidationPositionInfo = record TValidationPositionInfo = record
ValidationIndex: Integer; ValidationIndex, MinStart, MaxStart: Integer;
MinStart, MaxStart: Byte;
end; end;
TValidationPositionInfos = specialize TList<TValidationPositionInfo>; TValidationPositionInfos = specialize TList<TValidationPositionInfo>;
@ -122,9 +104,6 @@ type
// validation numbers from 'FValidation[i]' to 'FValidation[j - 1]' with a single space in between each pair of // validation numbers from 'FValidation[i]' to 'FValidation[j - 1]' with a single space in between each pair of
// them. // them.
FValidationLengths: TValidationLengths; FValidationLengths: TValidationLengths;
//FPatternLengths: TPatternLengths;
// 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: TIntegerArray; FMinIndices: TIntegerArray;
@ -134,13 +113,6 @@ type
// 1, 2, and 0 damages, respectively. // 1, 2, and 0 damages, respectively.
FDamagesBlocks: TDamagesBlocks; FDamagesBlocks: TDamagesBlocks;
procedure InitValidationLengths; procedure InitValidationLengths;
//// Returns an array 'a' of accumulated block lengths. 'a[i]' denotes the combined length of consecutive
//// blocks starting with 'FBlocks[i]' and all following with a single space in between each pair of
//// them.
//// Should be "function CalcBlockLengths: TBlockLengths;
//function CalcPatternLengths: TPatternLengths;
procedure InitMinIndices; procedure InitMinIndices;
function CalcCombinations(constref AIndices: TIntegerArray): Int64; function CalcCombinations(constref AIndices: TIntegerArray): Int64;
function CalcCombinationsBlock(const ABlock: string; constref ADamages: TDamages; const AStartIndex, AStopIndex: function CalcCombinationsBlock(const ABlock: string; constref ADamages: TDamages; const AStartIndex, AStopIndex:
@ -169,6 +141,8 @@ type
private private
// Keeping the binomial coefficients calculator here so it can be shared for all lines. // Keeping the binomial coefficients calculator here so it can be shared for all lines.
FBinomialCoefficients: TBinomialCoefficientCache; FBinomialCoefficients: TBinomialCoefficientCache;
// TODO: Remove FDebugIndex.
FDebugIndex: Integer;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
@ -180,31 +154,6 @@ type
implementation implementation
//{ TBlockAssignment }
//
//constructor TBlockAssignment.Create(const APattern: string; constref APrevious: TBlockAssignment);
//begin
// FPrevious := APrevious;
// FPattern := APattern;
// FValidation := TIntegerList.Create;
//end;
//
//destructor TBlockAssignment.Destroy;
//begin
// FValidation.Free;
// inherited Destroy;
//end;
//
//procedure TBlockAssignment.WriteDebug;
//var
// i: Integer;
//begin
// Write(FPattern, ' ', IntToStr(FValidation[0]));
// for i := 1 to FValidation.Count - 1 do
// Write(',', IntToStr(FValidation[i]));
// Write(' |');
//end;
{ TValidationToDamageAssignments } { TValidationToDamageAssignments }
function TValidationToDamageAssignments.CalcValidationSpan(constref ACurrentIndexArray: TIndexArray; function TValidationToDamageAssignments.CalcValidationSpan(constref ACurrentIndexArray: TIndexArray;
@ -258,14 +207,16 @@ begin
end; end;
// Checks if there is enough space after this damage for remaining validation numbers. // Checks if there is enough space after this damage for remaining validation numbers.
if FValidationLengths[i + 1, FValidationStopIndex + 1] + 1 > FDamages[ACurrentIndex].CharsRemaining then if (i < FValidationStopIndex)
and (FValidationLengths[i + 1, FValidationStopIndex + 1] + 1 > FDamages[ACurrentIndex].CharsRemaining) then
begin begin
Result := ivrSkip; Result := ivrSkip;
Exit; Exit;
end; end;
// Checks if there is enough space before this damage for previous validation numbers. // Checks if there is enough space before this damage for previous validation numbers.
if (FValidationStartIndex < i) and (FValidationLengths[FValidationStartIndex, i] + 1 >= FDamages[ACurrentIndex].Start) then if (FValidationStartIndex < i)
and (FValidationLengths[FValidationStartIndex, i] + 1 >= FDamages[ACurrentIndex].Start) then
begin begin
Result := ivrBacktrack; Result := ivrBacktrack;
Exit; Exit;
@ -316,9 +267,6 @@ begin
// Calculates start value such that the validation number just includes MinEnd. // Calculates start value such that the validation number just includes MinEnd.
//AStartIndexValue := info.MinEnd - FValidation[info.ValidationIndex] + 1; //AStartIndexValue := info.MinEnd - FValidation[info.ValidationIndex] + 1;
AStartIndexValue := info.MinStart; AStartIndexValue := info.MinStart;
////////////////////////////////////////////
Assert(AStartIndexValue > 0, 'start value ');
////////////////////////////////////////////
// Adjusts start value to avoid overlap of this validation number with the previous one (the one from previous // Adjusts start value to avoid overlap of this validation number with the previous one (the one from previous
// position info). // position info).
if ACurrentIndex > 0 then if ACurrentIndex > 0 then
@ -354,17 +302,6 @@ begin
end; end;
end; end;
//function TConditionRecord.CalcPatternLengths: TPatternLengths;
//var
// i: Integer;
//begin
// SetLength(Result, FBlockPatterns.Count + 1);
// Result[FBlockPatterns.Count] := 0;
// Result[FBlockPatterns.Count - 1] := Length(FBlockPatterns[FBlockPatterns.Count - 1]);
// for i := FBlockPatterns.Count - 2 downto 0 do
// Result[i] := Result[i + 1] + 1 + Length(FBlockPatterns[i]);
//end;
procedure TConditionRecord.InitMinIndices; procedure TConditionRecord.InitMinIndices;
var var
i, j, patternsLength: Integer; i, j, patternsLength: Integer;
@ -383,17 +320,39 @@ end;
function TConditionRecord.CalcCombinations(constref AIndices: TIntegerArray): Int64; function TConditionRecord.CalcCombinations(constref AIndices: TIntegerArray): Int64;
var var
i: Integer; i, j: Integer;
// TODO: Remove r.
r: Int64;
begin begin
{$ifdef debug}
for i in AIndices do for i in AIndices do
Write(i, ' '); Write(i, ' ');
WriteLn; WriteLn;
{$endif}
Result := 1; Result := 1;
i := 0; i := 0;
while (Result > 0) and (i < FBlocks.Count) do while (Result > 0) and (i < FBlocks.Count) do
begin begin
Result := Result * CalcCombinationsBlock(FBlocks[i], FDamagesBlocks[i], AIndices[i], AIndices[i + 1] - 1); if FDamagesBlocks[i].Count > 0 then
r := CalcCombinationsBlock(FBlocks[i], FDamagesBlocks[i], AIndices[i], AIndices[i + 1] - 1)
else begin
{$ifdef debug}
Write(' ', FBlocks[i], ' ');
for j := AIndices[i] to AIndices[i + 1] - 1 do
Write(FValidation[j], ' ');
WriteLn;
Write(' count/space/freedoms: ');
{$endif}
r := CalcCombinationsWildcardSequence(Length(FBlocks[i]), AIndices[i], AIndices[i + 1] - 1);
{$ifdef debug}
WriteLn(' result: ', r);
{$endif}
end;
{$ifdef debug}
WriteLn(' Result: ', r);
{$endif}
Result := Result * r;
Inc(i); Inc(i);
end; end;
end; end;
@ -405,10 +364,12 @@ var
indices: TIndexArray; indices: TIndexArray;
validationToDamageAssignments: TValidationToDamageAssignments; validationToDamageAssignments: TValidationToDamageAssignments;
begin begin
{$ifdef debug}
Write(' ', ABlock, ' '); Write(' ', ABlock, ' ');
for i := AStartIndex to AStopIndex do for i := AStartIndex to AStopIndex do
Write(FValidation[i], ' '); Write(FValidation[i], ' ');
WriteLn; WriteLn;
{$endif}
// No validation number assigned to this block. // No validation number assigned to this block.
if AStartIndex > AStopIndex then if AStartIndex > AStopIndex then
@ -423,7 +384,7 @@ begin
Result := CalcCombinationsBlockSingleValidation(Length(ABlock), ADamages, AStartIndex) Result := CalcCombinationsBlockSingleValidation(Length(ABlock), ADamages, AStartIndex)
// Multiple validation numbers assigned to this block. // Multiple validation numbers assigned to this block.
else begin else begin
/////////////////////////////// {$ifdef debug}
Write(' min before: '); Write(' min before: ');
for i := AStartIndex to AStopIndex do for i := AStartIndex to AStopIndex do
Write(FValidationLengths[AStartIndex, i + 1] - FValidation[i], ' '); Write(FValidationLengths[AStartIndex, i + 1] - FValidation[i], ' ');
@ -447,16 +408,19 @@ begin
Write(j - AStartIndex, ' '); Write(j - AStartIndex, ' ');
WriteLn; WriteLn;
end; end;
/////////////////////////////// {$endif}
Result := 0; Result := 0;
// Assigns validation numbers to specific damages. // Assigns validation numbers to specific damages.
validationToDamageAssignments := TValidationToDamageAssignments.Create(FValidation, FValidationLengths, ADamages, validationToDamageAssignments := TValidationToDamageAssignments.Create(FValidation, FValidationLengths, ADamages,
AStartIndex, AStopIndex); AStartIndex, AStopIndex);
{$ifdef debug}
WriteLn(' validation numbers (indices) per damages:'); WriteLn(' validation numbers (indices) per damages:');
{$endif}
for indices in validationToDamageAssignments do for indices in validationToDamageAssignments do
begin begin
{$ifdef debug}
Write(' '); Write(' ');
for i := 0 to ADamages.Count - 1 do for i := 0 to ADamages.Count - 1 do
Write(FValidation[indices[i]], ' '); Write(FValidation[indices[i]], ' ');
@ -464,11 +428,11 @@ begin
for i := 0 to ADamages.Count - 1 do for i := 0 to ADamages.Count - 1 do
Write(indices[i] - AStartIndex, ' '); Write(indices[i] - AStartIndex, ' ');
WriteLn(')'); WriteLn(')');
{$endif}
Result := Result + CalcCombinationsBlockMultiValidations(Length(ABlock), ADamages, indices, AStartIndex, AStopIndex); Result := Result + CalcCombinationsBlockMultiValidations(Length(ABlock), ADamages, indices, AStartIndex, AStopIndex);
end; end;
validationToDamageAssignments.Free; validationToDamageAssignments.Free;
end; end;
WriteLn(' Result: ', Result);
end; end;
function TConditionRecord.CalcCombinationsBlockSingleValidation(const ABlockLength: Integer; constref ADamages: function TConditionRecord.CalcCombinationsBlockSingleValidation(const ABlockLength: Integer; constref ADamages:
@ -515,12 +479,12 @@ begin
// Finalizes current info record. // Finalizes current info record.
position.MaxStart := Min(position.MaxStart, ADamages[i].Start - 1 - FValidation[position.ValidationIndex]); position.MaxStart := Min(position.MaxStart, ADamages[i].Start - 1 - FValidation[position.ValidationIndex]);
position.MinStart := Max(position.MinStart, position.MinStart := Max(position.MinStart,
ADamages[i - 1].Start + ADamages[i - 1].Length - 1 - FValidation[position.ValidationIndex] + 1); ADamages[i - 1].Start + ADamages[i - 1].Length - FValidation[position.ValidationIndex]);
positions.Add(position); positions.Add(position);
// Initializes next info record. // Initializes next info record.
position.ValidationIndex := AIndices[i]; position.ValidationIndex := AIndices[i];
position.MaxStart := ADamages[i].Start; position.MaxStart := ADamages[i].Start;
position.MinStart := position.MinStart + FValidation[position.ValidationIndex] + 1; position.MinStart := position.MinStart + FValidationLengths[AIndices[i - 1], AIndices[i]] + 1; //FValidation[position.ValidationIndex - 1] + 1;
end; end;
// Finalizes last info record. // Finalizes last info record.
position.MaxStart := Min(position.MaxStart, ABlockLength + 1 - FValidation[position.ValidationIndex]); position.MaxStart := Min(position.MaxStart, ABlockLength + 1 - FValidation[position.ValidationIndex]);
@ -528,11 +492,13 @@ begin
ADamages[high].Start + ADamages[high].Length - FValidation[position.ValidationIndex]); ADamages[high].Start + ADamages[high].Length - FValidation[position.ValidationIndex]);
positions.Add(position); positions.Add(position);
{$ifdef debug}
WriteLn(' validation position infos'); WriteLn(' validation position infos');
for position in positions do for position in positions do
WriteLn(' ', position.ValidationIndex, ' ', position.MinStart, ' ', position.MaxStart); WriteLn(' ', position.ValidationIndex, ' ', position.MinStart, ' ', position.MaxStart);
WriteLn(' offsets'); WriteLn(' offsets');
{$endif}
Result := 0; Result := 0;
validationPositionOffsets := TValidationPositionOffsets.Create(FValidation, positions); validationPositionOffsets := TValidationPositionOffsets.Create(FValidation, positions);
for offsets in validationPositionOffsets do for offsets in validationPositionOffsets do
@ -547,29 +513,37 @@ function TConditionRecord.CalcCombinationsBlockAssignedValidations(const ABlockL
var var
i, space: Integer; i, space: Integer;
begin begin
{$ifdef debug}
Write(' '); Write(' ');
for i in AOffsets do for i in AOffsets do
Write(i, ' '); Write(i, ' ');
Write(' count/space/freedoms: '); Write(' count/space/freedoms: ');
{$endif}
space := AOffsets[0] - 2; space := AOffsets[0] - 2;
Result := CalcCombinationsWildcardSequence(space, AStartIndex, APositionInfos[0].ValidationIndex); Result := CalcCombinationsWildcardSequence(space, AStartIndex, APositionInfos[0].ValidationIndex - 1);
if Result = 0 then begin if Result = 0 then begin
{$ifdef debug}
WriteLn(' result: ', Result); WriteLn(' result: ', Result);
{$endif}
Exit; Exit;
end; end;
for i := 0 to APositionInfos.Count - 2 do begin for i := 0 to APositionInfos.Count - 2 do begin
space := AOffsets[i + 1] - AOffsets[i] - FValidation[APositionInfos[i].ValidationIndex] - 2; space := AOffsets[i + 1] - AOffsets[i] - FValidation[APositionInfos[i].ValidationIndex] - 2;
Result := Result * CalcCombinationsWildcardSequence(space, APositionInfos[i].ValidationIndex + 1, APositionInfos[i + 1].ValidationIndex); Result := Result * CalcCombinationsWildcardSequence(space, APositionInfos[i].ValidationIndex + 1, APositionInfos[i + 1].ValidationIndex - 1);
if Result = 0 then begin if Result = 0 then begin
{$ifdef debug}
WriteLn(' result: ', Result); WriteLn(' result: ', Result);
{$endif}
Exit; Exit;
end; end;
end; end;
space := ABlockLength - AOffsets[APositionInfos.Count - 1] - FValidation[APositionInfos.Last.ValidationIndex]; space := ABlockLength - AOffsets[APositionInfos.Count - 1] - FValidation[APositionInfos.Last.ValidationIndex];
Result := Result * CalcCombinationsWildcardSequence(space, APositionInfos.Last.ValidationIndex + 1, AStopIndex + 1); Result := Result * CalcCombinationsWildcardSequence(space, APositionInfos.Last.ValidationIndex + 1, AStopIndex);
{$ifdef debug}
WriteLn(' result: ', Result); WriteLn(' result: ', Result);
{$endif}
end; end;
function TConditionRecord.CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer): function TConditionRecord.CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer):
@ -577,11 +551,13 @@ function TConditionRecord.CalcCombinationsWildcardSequence(const ASequenceLength
var var
count, freedoms: Integer; count, freedoms: Integer;
begin begin
if AStartIndex < AStopIndex then if AStartIndex < AStopIndex + 1 then
begin begin
count := AStopIndex - AStartIndex; count := AStopIndex + 1 - AStartIndex;
freedoms := ASequenceLength - FValidationLengths[AStartIndex, AStopIndex]; freedoms := ASequenceLength - FValidationLengths[AStartIndex, AStopIndex + 1];
{$ifdef debug}
Write(count, '/', ASequenceLength, '/', freedoms, ' '); Write(count, '/', ASequenceLength, '/', freedoms, ' ');
{$endif}
if freedoms >= 0 then if freedoms >= 0 then
Result := FBinomialCoefficients.Get(count + freedoms, freedoms) Result := FBinomialCoefficients.Get(count + freedoms, freedoms)
else else
@ -589,7 +565,9 @@ begin
end end
else begin else begin
Result := 1; Result := 1;
{$ifdef debug}
Write('X '); Write('X ');
{$endif}
end; end;
end; end;
@ -658,7 +636,12 @@ function TConditionRecord.GenerateBlockAssignments: Int64;
var var
indices: array of Integer; indices: array of Integer;
i, j, k, high: Integer; i, j, k, high: Integer;
// TODO: Remove r, count, misses.
r: Int64;
count, misses: Integer;
begin begin
count := 0;
misses := 0;
// Each loop (each call to 'CalcCombinations') represents an independent set of arrangements, defined by 'indices', // Each loop (each call to 'CalcCombinations') represents an independent set of arrangements, defined by 'indices',
// where specific validation numbers are assigned to specific block patterns. // where specific validation numbers are assigned to specific block patterns.
// //
@ -684,14 +667,6 @@ begin
i := k + 1; i := k + 1;
while i <= high do while i <= high do
begin begin
////j := indices[k];
//j := indices[i - 1];
//// TODO: FPatternLengths is only used to find the right j, so we should instead cache values to get j directly.
//while FValidationLengths[j, FValidation.Count] > FPatternLengths[i] do
// Inc(j);
//indices[i] := j;
//WriteLn(j, ' ', FMinIndices[i - 1]);
indices[i] := Max(indices[i - 1], FMinIndices[i - 1]); indices[i] := Max(indices[i - 1], FMinIndices[i - 1]);
while FValidationLengths[indices[i - 1], indices[i]] > Length(FBlocks[i - 1]) do while FValidationLengths[indices[i - 1], indices[i]] > Length(FBlocks[i - 1]) do
begin begin
@ -702,10 +677,11 @@ begin
Inc(i); Inc(i);
end; end;
//if FValidationLengths[indices[0], indices[1]] > Length(FBlocks[0]) then Inc(count);
// Break; r := CalcCombinations(indices);
if r = 0 then
Result := Result + CalcCombinations(indices); Inc(misses);
Result := Result + r;
k := high; k := high;
while (k > 0) while (k > 0)
@ -714,12 +690,14 @@ begin
Dec(k); Dec(k);
Inc(indices[k]); Inc(indices[k]);
until k = 0; until k = 0;
WriteLn(' missed: ', misses, '/', count);
end; end;
{ THotSprings } { THotSprings }
constructor THotSprings.Create; constructor THotSprings.Create;
begin begin
FDebugIndex := 0;
FBinomialCoefficients := TBinomialCoefficientCache.Create; FBinomialCoefficients := TBinomialCoefficientCache.Create;
end; end;
@ -736,8 +714,10 @@ var
part, unfolded: string; part, unfolded: string;
i: Integer; i: Integer;
begin begin
{$ifdef debug}
WriteLn(ALine); WriteLn(ALine);
WriteLn; WriteLn;
{$endif}
conditionRecord1 := TConditionRecord.Create(FBinomialCoefficients); conditionRecord1 := TConditionRecord.Create(FBinomialCoefficients);
conditionRecord2 := TConditionRecord.Create(FBinomialCoefficients); conditionRecord2 := TConditionRecord.Create(FBinomialCoefficients);
@ -760,30 +740,23 @@ begin
for i := 1 to CPart2Repetition do for i := 1 to CPart2Repetition do
conditionRecord2.Validation.AddRange(conditionRecord1.Validation); conditionRecord2.Validation.AddRange(conditionRecord1.Validation);
//for part in conditionRecord1.Blocks do WriteLn(FDebugIndex + 1);
// WriteLn(part); Inc(FDebugIndex);
//for i in conditionRecord1.Validation do FPart1 := FPart1 + conditionRecord1.GenerateBlockAssignments;
// WriteLn(i);
//
//WriteLn;
//
// for part in conditionRecord2.Blocks do
// WriteLn(part);
// for i in conditionRecord2.Validation do
// WriteLn(i);
// WriteLn;
FPart2 := FPart2 + conditionRecord2.GenerateBlockAssignments; FPart2 := FPart2 + conditionRecord2.GenerateBlockAssignments;
conditionRecord1.Free; conditionRecord1.Free;
conditionRecord2.Free; conditionRecord2.Free;
{$ifdef debug}
WriteLn('------------------------'); WriteLn('------------------------');
WriteLn; WriteLn;
{$endif}
end; end;
procedure THotSprings.Finish; procedure THotSprings.Finish;
begin begin
ProcessDataLine('?????#??##??????#??????? 5,3,1,2,1');
end; end;
function THotSprings.GetDataFileName: string; function THotSprings.GetDataFileName: string;