From 1642c7dcfb7cf6cf2533833ba16280ac8b79d966 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Tue, 12 Nov 2024 19:16:12 +0100 Subject: [PATCH] Updated day 12 WIP solver (correct solution) --- solvers/UHotSprings.pas | 199 +++++++++++++++++----------------------- 1 file changed, 86 insertions(+), 113 deletions(-) diff --git a/solvers/UHotSprings.pas b/solvers/UHotSprings.pas index 70d0902..8dbfd56 100644 --- a/solvers/UHotSprings.pas +++ b/solvers/UHotSprings.pas @@ -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; - 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; @@ -89,8 +72,7 @@ type { TValidationPositionInfo } TValidationPositionInfo = record - ValidationIndex: Integer; - MinStart, MaxStart: Byte; + ValidationIndex, MinStart, MaxStart: Integer; end; TValidationPositionInfos = specialize TList; @@ -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;