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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

199
solvers/UHotSprings.pas
View File

@ -21,6 +21,9 @@ unit UHotSprings;
interface
// TODO: Remove this and the ifdefs.
{$define debug}
uses
Classes, SysUtils, Math, Generics.Collections, USolver, UCommon, UMultiIndexEnumerator, UBinomialCoefficients;
@ -28,37 +31,17 @@ const
COperationalChar = '.';
CDamagedChar = '#';
CWildcardChar = '?';
//COperationalPatternChars = [COperationalChar, CWildcardChar];
//CDamagedPatternChars = [CDamagedChar, CWildcardChar];
CPart2Repetition = 1;
CPart2Repetition = 5;
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;
//TPatternLengths = array of Integer;
// TODO: TIntegerArray probably not needed.
TIntegerArray = array of Integer;
{ TDamage }
TDamage = record
Start, Length, CharsRemaining: Byte;
Start, Length, CharsRemaining: Integer;
end;
TDamages = specialize TList<TDamage>;
@ -89,8 +72,7 @@ type
{ TValidationPositionInfo }
TValidationPositionInfo = record
ValidationIndex: Integer;
MinStart, MaxStart: Byte;
ValidationIndex, MinStart, MaxStart: Integer;
end;
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
// them.
FValidationLengths: TValidationLengths;
//FPatternLengths: TPatternLengths;
// 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: TIntegerArray;
@ -134,13 +113,6 @@ type
// 1, 2, and 0 damages, respectively.
FDamagesBlocks: TDamagesBlocks;
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;
function CalcCombinations(constref AIndices: TIntegerArray): Int64;
function CalcCombinationsBlock(const ABlock: string; constref ADamages: TDamages; const AStartIndex, AStopIndex:
@ -169,6 +141,8 @@ type
private
// Keeping the binomial coefficients calculator here so it can be shared for all lines.
FBinomialCoefficients: TBinomialCoefficientCache;
// TODO: Remove FDebugIndex.
FDebugIndex: Integer;
public
constructor Create;
destructor Destroy; override;
@ -180,31 +154,6 @@ type
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 }
function TValidationToDamageAssignments.CalcValidationSpan(constref ACurrentIndexArray: TIndexArray;
@ -258,14 +207,16 @@ begin
end;
// 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
Result := ivrSkip;
Exit;
end;
// 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
Result := ivrBacktrack;
Exit;
@ -316,9 +267,6 @@ begin
// Calculates start value such that the validation number just includes MinEnd.
//AStartIndexValue := info.MinEnd - FValidation[info.ValidationIndex] + 1;
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
// position info).
if ACurrentIndex > 0 then
@ -354,17 +302,6 @@ begin
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;
var
i, j, patternsLength: Integer;
@ -383,17 +320,39 @@ end;
function TConditionRecord.CalcCombinations(constref AIndices: TIntegerArray): Int64;
var
i: Integer;
i, j: Integer;
// TODO: Remove r.
r: Int64;
begin
{$ifdef debug}
for i in AIndices do
Write(i, ' ');
WriteLn;
{$endif}
Result := 1;
i := 0;
while (Result > 0) and (i < FBlocks.Count) do
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);
end;
end;
@ -405,10 +364,12 @@ var
indices: TIndexArray;
validationToDamageAssignments: TValidationToDamageAssignments;
begin
{$ifdef debug}
Write(' ', ABlock, ' ');
for i := AStartIndex to AStopIndex do
Write(FValidation[i], ' ');
WriteLn;
{$endif}
// No validation number assigned to this block.
if AStartIndex > AStopIndex then
@ -423,7 +384,7 @@ begin
Result := CalcCombinationsBlockSingleValidation(Length(ABlock), ADamages, AStartIndex)
// Multiple validation numbers assigned to this block.
else begin
///////////////////////////////
{$ifdef debug}
Write(' min before: ');
for i := AStartIndex to AStopIndex do
Write(FValidationLengths[AStartIndex, i + 1] - FValidation[i], ' ');
@ -447,16 +408,19 @@ begin
Write(j - AStartIndex, ' ');
WriteLn;
end;
///////////////////////////////
{$endif}
Result := 0;
// Assigns validation numbers to specific damages.
validationToDamageAssignments := TValidationToDamageAssignments.Create(FValidation, FValidationLengths, ADamages,
AStartIndex, AStopIndex);
{$ifdef debug}
WriteLn(' validation numbers (indices) per damages:');
{$endif}
for indices in validationToDamageAssignments do
begin
{$ifdef debug}
Write(' ');
for i := 0 to ADamages.Count - 1 do
Write(FValidation[indices[i]], ' ');
@ -464,11 +428,11 @@ begin
for i := 0 to ADamages.Count - 1 do
Write(indices[i] - AStartIndex, ' ');
WriteLn(')');
{$endif}
Result := Result + CalcCombinationsBlockMultiValidations(Length(ABlock), ADamages, indices, AStartIndex, AStopIndex);
end;
validationToDamageAssignments.Free;
end;
WriteLn(' Result: ', Result);
end;
function TConditionRecord.CalcCombinationsBlockSingleValidation(const ABlockLength: Integer; constref ADamages:
@ -515,12 +479,12 @@ begin
// Finalizes current info record.
position.MaxStart := Min(position.MaxStart, ADamages[i].Start - 1 - FValidation[position.ValidationIndex]);
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);
// Initializes next info record.
position.ValidationIndex := AIndices[i];
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;
// Finalizes last info record.
position.MaxStart := Min(position.MaxStart, ABlockLength + 1 - FValidation[position.ValidationIndex]);
@ -528,11 +492,13 @@ begin
ADamages[high].Start + ADamages[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(FValidation, positions);
for offsets in validationPositionOffsets do
@ -547,29 +513,37 @@ function TConditionRecord.CalcCombinationsBlockAssignedValidations(const ABlockL
var
i, space: Integer;
begin
{$ifdef debug}
Write(' ');
for i in AOffsets do
Write(i, ' ');
Write(' count/space/freedoms: ');
{$endif}
space := AOffsets[0] - 2;
Result := CalcCombinationsWildcardSequence(space, AStartIndex, APositionInfos[0].ValidationIndex);
Result := CalcCombinationsWildcardSequence(space, AStartIndex, APositionInfos[0].ValidationIndex - 1);
if Result = 0 then begin
{$ifdef debug}
WriteLn(' result: ', Result);
{$endif}
Exit;
end;
for i := 0 to APositionInfos.Count - 2 do begin
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
{$ifdef debug}
WriteLn(' result: ', Result);
{$endif}
Exit;
end;
end;
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);
{$endif}
end;
function TConditionRecord.CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer):
@ -577,11 +551,13 @@ function TConditionRecord.CalcCombinationsWildcardSequence(const ASequenceLength
var
count, freedoms: Integer;
begin
if AStartIndex < AStopIndex then
if AStartIndex < AStopIndex + 1 then
begin
count := AStopIndex - AStartIndex;
freedoms := ASequenceLength - FValidationLengths[AStartIndex, AStopIndex];
count := AStopIndex + 1 - AStartIndex;
freedoms := ASequenceLength - FValidationLengths[AStartIndex, AStopIndex + 1];
{$ifdef debug}
Write(count, '/', ASequenceLength, '/', freedoms, ' ');
{$endif}
if freedoms >= 0 then
Result := FBinomialCoefficients.Get(count + freedoms, freedoms)
else
@ -589,7 +565,9 @@ begin
end
else begin
Result := 1;
{$ifdef debug}
Write('X ');
{$endif}
end;
end;
@ -658,7 +636,12 @@ function TConditionRecord.GenerateBlockAssignments: Int64;
var
indices: array of Integer;
i, j, k, high: Integer;
// TODO: Remove r, count, misses.
r: Int64;
count, misses: Integer;
begin
count := 0;
misses := 0;
// 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.
//
@ -684,14 +667,6 @@ begin
i := k + 1;
while i <= high do
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]);
while FValidationLengths[indices[i - 1], indices[i]] > Length(FBlocks[i - 1]) do
begin
@ -702,10 +677,11 @@ begin
Inc(i);
end;
//if FValidationLengths[indices[0], indices[1]] > Length(FBlocks[0]) then
// Break;
Result := Result + CalcCombinations(indices);
Inc(count);
r := CalcCombinations(indices);
if r = 0 then
Inc(misses);
Result := Result + r;
k := high;
while (k > 0)
@ -714,12 +690,14 @@ begin
Dec(k);
Inc(indices[k]);
until k = 0;
WriteLn(' missed: ', misses, '/', count);
end;
{ THotSprings }
constructor THotSprings.Create;
begin
FDebugIndex := 0;
FBinomialCoefficients := TBinomialCoefficientCache.Create;
end;
@ -736,8 +714,10 @@ var
part, unfolded: string;
i: Integer;
begin
{$ifdef debug}
WriteLn(ALine);
WriteLn;
{$endif}
conditionRecord1 := TConditionRecord.Create(FBinomialCoefficients);
conditionRecord2 := TConditionRecord.Create(FBinomialCoefficients);
@ -760,30 +740,23 @@ begin
for i := 1 to CPart2Repetition do
conditionRecord2.Validation.AddRange(conditionRecord1.Validation);
//for part in conditionRecord1.Blocks do
// WriteLn(part);
//for i in conditionRecord1.Validation do
// WriteLn(i);
//
//WriteLn;
//
// for part in conditionRecord2.Blocks do
// WriteLn(part);
// for i in conditionRecord2.Validation do
// WriteLn(i);
// WriteLn;
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;
begin
ProcessDataLine('?????#??##??????#??????? 5,3,1,2,1');
end;
function THotSprings.GetDataFileName: string;