From c0ee7894ae8408ca223ba407f804a15ffb99f0ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Wed, 13 Dec 2023 12:32:12 +0100 Subject: [PATCH 01/14] Added initial attempt for "Day 12: Hot Springs", part 2 including test cases --- solvers/UHotSprings.pas | 27 +++++--- tests/UHotSpringsTestCases.pas | 110 ++++++++++++++++++++++++++------- 2 files changed, 109 insertions(+), 28 deletions(-) diff --git a/solvers/UHotSprings.pas b/solvers/UHotSprings.pas index 8f12cab..3244dd6 100644 --- a/solvers/UHotSprings.pas +++ b/solvers/UHotSprings.pas @@ -30,6 +30,7 @@ const CWildcardChar = '?'; COperationalPatternChars = [COperationalChar, CWildcardChar]; CDamagedPatternChars = [CDamagedChar, CWildcardChar]; + CPart2Repetition = 4; type @@ -40,7 +41,7 @@ type FValidation: specialize TList; FSpringPattern: string; procedure ExtendArrangement(const AArrangement: string; const ARemainingFreeOperationalCount, ACurrentValidationIndex: - Integer); + Integer; var AArrangementCount: Int64); function TryAppendOperationalChar(var AArrangement: string): Boolean; function TryAppendValidationBlock(var AArrangement: string; const ALength: Integer): Boolean; public @@ -57,19 +58,19 @@ implementation { THotSprings } procedure THotSprings.ExtendArrangement(const AArrangement: string; const ARemainingFreeOperationalCount, - ACurrentValidationIndex: Integer); + ACurrentValidationIndex: Integer; var AArrangementCount: Int64); var match: Boolean; temp: string; begin if Length(AArrangement) = Length(FSpringPattern) then - Inc(FPart1) + Inc(AArrangementCount) else begin temp := AArrangement; // Tries to append a dot (operational) to the current arrangement. if (ARemainingFreeOperationalCount > 0) and TryAppendOperationalChar(temp) then begin - ExtendArrangement(temp, ARemainingFreeOperationalCount - 1, ACurrentValidationIndex); + ExtendArrangement(temp, ARemainingFreeOperationalCount - 1, ACurrentValidationIndex, AArrangementCount); end; // Tries to append the current validation block (damaged) to the current arrangement. @@ -85,7 +86,7 @@ begin match := False; if match then - ExtendArrangement(temp, ARemainingFreeOperationalCount, ACurrentValidationIndex + 1); + ExtendArrangement(temp, ARemainingFreeOperationalCount, ACurrentValidationIndex + 1, AArrangementCount); end; end; end; @@ -132,7 +133,7 @@ end; procedure THotSprings.ProcessDataLine(const ALine: string); var split: TStringArray; - i, val, maxFreeOperationalCount: Integer; + i, j, val, maxFreeOperationalCount: Integer; begin FValidation.Clear; split := ALine.Split([' ', ',']); @@ -146,7 +147,19 @@ begin Dec(maxFreeOperationalCount, val); end; - ExtendArrangement('', maxFreeOperationalCount, 0); + ExtendArrangement('', maxFreeOperationalCount, 0, FPart1); + WriteLn('Part 1: ', FPart1); + + for i := 1 to CPart2Repetition do + begin + FSpringPattern := FSpringPattern + CWildcardChar + split[0]; + for j := 0 to Length(split) - 2 do + FValidation.Add(FValidation[j]); + end; + maxFreeOperationalCount := (CPart2Repetition + 1) * maxFreeOperationalCount; + + ExtendArrangement('', maxFreeOperationalCount, 0, FPart2); + WriteLn('Part 2: ', FPart2); end; procedure THotSprings.Finish; diff --git a/tests/UHotSpringsTestCases.pas b/tests/UHotSpringsTestCases.pas index 03f9a92..6819d82 100644 --- a/tests/UHotSpringsTestCases.pas +++ b/tests/UHotSpringsTestCases.pas @@ -26,6 +26,16 @@ uses type + { THotSpringsFullDataTestCase } + + THotSpringsFullDataTestCase = class(TEngineBaseTest) + protected + function CreateSolver: ISolver; override; + published + procedure TestPart1; + procedure TestPart2; + end; + { THotSpringsExampleTestCase } THotSpringsExampleTestCase = class(TExampleEngineBaseTest) @@ -33,6 +43,7 @@ type function CreateSolver: ISolver; override; published procedure TestPart1; + procedure TestPart2; end; { THotSpringsTestCase } @@ -40,18 +51,29 @@ type THotSpringsTestCase = class(TSolverTestCase) protected function CreateSolver: ISolver; override; - procedure TestSingleLine(const ALine: string; const AValue: Integer); + procedure TestSingleLine(const ALine: string); published - procedure TestExampleLine1; - procedure TestExampleLine2; - procedure TestExampleLine3; - procedure TestExampleLine4; - procedure TestExampleLine5; - procedure TestExampleLine6; + procedure TestExampleLine1Part1; + procedure TestExampleLine2Part1; + procedure TestExampleLine3Part1; + procedure TestExampleLine4Part1; + procedure TestExampleLine5Part1; + procedure TestExampleLine6Part1; + procedure TestExampleLine1Part2; + procedure TestExampleLine2Part2; + procedure TestExampleLine3Part2; + procedure TestExampleLine4Part2; + procedure TestExampleLine5Part2; + procedure TestExampleLine6Part2; end; implementation +procedure THotSpringsFullDataTestCase.TestPart2; +begin + AssertEquals(-1, FSolver.GetResultPart2); +end; + { THotSpringsExampleTestCase } function THotSpringsExampleTestCase.CreateSolver: ISolver; @@ -64,6 +86,11 @@ begin AssertEquals(21, FSolver.GetResultPart1); end; +procedure THotSpringsExampleTestCase.TestPart2; +begin + AssertEquals(525152, FSolver.GetResultPart2); +end; + { THotSpringsTestCase } function THotSpringsTestCase.CreateSolver: ISolver; @@ -71,42 +98,83 @@ begin Result := THotSprings.Create; end; -procedure THotSpringsTestCase.TestSingleLine(const ALine: string; const AValue: Integer); +procedure THotSpringsTestCase.TestSingleLine(const ALine: string); begin FSolver.Init; FSolver.ProcessDataLine(ALine); FSolver.Finish; - AssertEquals(AValue, FSolver.GetResultPart1); end; -procedure THotSpringsTestCase.TestExampleLine1; +procedure THotSpringsTestCase.TestExampleLine1Part1; begin - TestSingleLine('???.### 1,1,3', 1); + TestSingleLine('???.### 1,1,3'); + AssertEquals(1, FSolver.GetResultPart1); end; -procedure THotSpringsTestCase.TestExampleLine2; +procedure THotSpringsTestCase.TestExampleLine2Part1; begin - TestSingleLine('.??..??...?##. 1,1,3', 4); + TestSingleLine('.??..??...?##. 1,1,3'); + AssertEquals(4, FSolver.GetResultPart1); end; -procedure THotSpringsTestCase.TestExampleLine3; +procedure THotSpringsTestCase.TestExampleLine3Part1; begin - TestSingleLine('?#?#?#?#?#?#?#? 1,3,1,6', 1); + TestSingleLine('?#?#?#?#?#?#?#? 1,3,1,6'); + AssertEquals(1, FSolver.GetResultPart1); end; -procedure THotSpringsTestCase.TestExampleLine4; +procedure THotSpringsTestCase.TestExampleLine4Part1; begin - TestSingleLine('????.#...#... 4,1,1', 1); + TestSingleLine('????.#...#... 4,1,1'); + AssertEquals(1, FSolver.GetResultPart1); end; -procedure THotSpringsTestCase.TestExampleLine5; +procedure THotSpringsTestCase.TestExampleLine5Part1; begin - TestSingleLine('????.######..#####. 1,6,5', 4); + TestSingleLine('????.######..#####. 1,6,5'); + AssertEquals(4, FSolver.GetResultPart1); end; -procedure THotSpringsTestCase.TestExampleLine6; +procedure THotSpringsTestCase.TestExampleLine6Part1; begin - TestSingleLine('?###???????? 3,2,1', 10); + TestSingleLine('?###???????? 3,2,1'); + AssertEquals(10, FSolver.GetResultPart1); +end; + +procedure THotSpringsTestCase.TestExampleLine1Part2; +begin + TestSingleLine('???.### 1,1,3'); + AssertEquals(1, FSolver.GetResultPart2); +end; + +procedure THotSpringsTestCase.TestExampleLine2Part2; +begin + TestSingleLine('.??..??...?##. 1,1,3'); + AssertEquals(16384, FSolver.GetResultPart2); +end; + +procedure THotSpringsTestCase.TestExampleLine3Part2; +begin + TestSingleLine('?#?#?#?#?#?#?#? 1,3,1,6'); + AssertEquals(1, FSolver.GetResultPart2); +end; + +procedure THotSpringsTestCase.TestExampleLine4Part2; +begin + TestSingleLine('????.#...#... 4,1,1'); + AssertEquals(16, FSolver.GetResultPart2); +end; + +procedure THotSpringsTestCase.TestExampleLine5Part2; +begin + TestSingleLine('????.######..#####. 1,6,5'); + AssertEquals(2500, FSolver.GetResultPart2); +end; + +procedure THotSpringsTestCase.TestExampleLine6Part2; +begin + TestSingleLine('?###???????? 3,2,1'); + AssertEquals(506250, FSolver.GetResultPart2); end; initialization From 151b5dc49ad9fb8fa93a2dbe659f5f4e470e1443 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Tue, 15 Oct 2024 11:45:44 +0200 Subject: [PATCH 02/14] Updated day 12 WIP solver --- UCommon.pas | 5 +- solvers/UHotSprings.pas | 500 +++++++++++++++++++++++++++++++++------- 2 files changed, 421 insertions(+), 84 deletions(-) diff --git a/UCommon.pas b/UCommon.pas index 0e674d9..00961f0 100644 --- a/UCommon.pas +++ b/UCommon.pas @@ -22,7 +22,7 @@ unit UCommon; interface uses - Classes, SysUtils; + Classes, SysUtils, Generics.Collections; type PPoint = ^TPoint; @@ -39,6 +39,9 @@ const CDirectionLeftUp: TPoint = (X: -1; Y: -1); CPCardinalDirections: array[0..3] of PPoint = (@CDirectionRight, @CDirectionDown, @CDirectionLeft, @CDirectionUp); +type + TIntegerList = specialize TList; + implementation end. diff --git a/solvers/UHotSprings.pas b/solvers/UHotSprings.pas index 3244dd6..e155e57 100644 --- a/solvers/UHotSprings.pas +++ b/solvers/UHotSprings.pas @@ -1,6 +1,6 @@ { Solutions to the Advent Of Code. - Copyright (C) 2023 Stefan Müller + Copyright (C) 2023-2024 Stefan Müller This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software @@ -22,31 +22,97 @@ unit UHotSprings; interface uses - Classes, SysUtils, Generics.Collections, USolver; + Classes, SysUtils, Math, Generics.Collections, USolver, UCommon; const COperationalChar = '.'; CDamagedChar = '#'; CWildcardChar = '?'; - COperationalPatternChars = [COperationalChar, CWildcardChar]; - CDamagedPatternChars = [CDamagedChar, CWildcardChar]; - CPart2Repetition = 4; + //COperationalPatternChars = [COperationalChar, CWildcardChar]; + //CDamagedPatternChars = [CDamagedChar, CWildcardChar]; + CPart2Repetition = 2; 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; + TIntegerArray = array of Integer; + + { TDamage } + + TDamage = record + Start, Length, CharsRemaining: Byte; + end; + + TDamages = specialize TList; + TDamagesBlocks = specialize TObjectList; + + { TConditionRecord } + + TConditionRecord = class + private + FValidation: TIntegerList; + // List of non-empty, maximum-length parts of the pattern without operational springs. + FBlockPatterns: TStringList; + // Array 'a' of accumulated validation block lengths. 'a[i, j]' denotes the combined length of consecutive + // 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 block patterns starting at 'FBlockPatterns[i]'. + FMinIndices: TIntegerArray; + // List 'a' of lists of damages in a block pattern. Each list of damages 'a[i]' contains exactly one entry for each + // block of consecutive damages characters in the i-th block pattern. + // For example, if the pattern is '?#.??##?#?..??', then 'FDamagesBlocks' would have 3 entries, which are lists of + // 1, 2, and 0 damages, respectively. + FDamagesBlocks: TDamagesBlocks; + procedure InitValidationLengths; + + //// Returns an array 'a' of accumulated pattern block lengths. 'a[i]' denotes the combined length of consecutive + //// pattern blocks starting with 'FBlockPatterns[i]' and all following with a single space in between each pair of + //// them. + //function CalcPatternLengths: TPatternLengths; + + procedure InitMinIndices; + function CalcCombinations(constref AIndices: TIntegerArray): Int64; + function CalcCombinationsSingleBlock(const APattern: string; constref ADamages: TDamages; const AStartIndex, + AStopIndex: Integer): Int64; + function CalcCombinationsSingleBlockSingleValidation(const APattern: string; constref ADamages: TDamages; + const AIndex: Integer): Int64; + function ParseDamages(const APattern: string): TDamages; + public + property BlockPatterns: TStringList read FBlockPatterns; + property Validation: TIntegerList read FValidation; + constructor Create; + destructor Destroy; override; + // Adds all non-empty, maximum-length parts of the pattern without operational springs. + procedure AddBlockPatterns(const APattern: string); + function GenerateBlockAssignments: Int64; + end; + { THotSprings } THotSprings = class(TSolver) - private - FValidation: specialize TList; - FSpringPattern: string; - procedure ExtendArrangement(const AArrangement: string; const ARemainingFreeOperationalCount, ACurrentValidationIndex: - Integer; var AArrangementCount: Int64); - function TryAppendOperationalChar(var AArrangement: string): Boolean; - function TryAppendValidationBlock(var AArrangement: string; const ALength: Integer): Boolean; public - constructor Create; - destructor Destroy; override; procedure ProcessDataLine(const ALine: string); override; procedure Finish; override; function GetDataFileName: string; override; @@ -55,111 +121,379 @@ type implementation -{ THotSprings } +//{ 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; -procedure THotSprings.ExtendArrangement(const AArrangement: string; const ARemainingFreeOperationalCount, - ACurrentValidationIndex: Integer; var AArrangementCount: Int64); +{ TConditionRecord } + +procedure TConditionRecord.InitValidationLengths; var - match: Boolean; - temp: string; + i, j: Integer; begin - if Length(AArrangement) = Length(FSpringPattern) then - Inc(AArrangementCount) + SetLength(FValidationLengths, FValidation.Count + 1, FValidation.Count + 1); + for i := 0 to FValidation.Count do + begin + FValidationLengths[i, i] := 0; + for j := i + 1 to FValidation.Count do + if FValidationLengths[i, j - 1] <> 0 then + FValidationLengths[i, j] := FValidationLengths[i, j - 1] + FValidation[j - 1] + 1 + else + FValidationLengths[i, j] := FValidationLengths[i, j - 1] + FValidation[j - 1] + 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; +begin + SetLength(FMinIndices, FBlockPatterns.Count - 1); + patternsLength := Length(FBlockPatterns[FBlockPatterns.Count - 1]); + j := FValidation.Count; + for i := FBlockPatterns.Count - 2 downto 0 do + begin + while (j >= 0) and (FValidationLengths[j, FValidation.Count] <= patternsLength) do + Dec(j); + FMinIndices[i] := j + 1; + patternsLength := patternsLength + 1 + Length(FBlockPatterns[i]); + end; +end; + +function TConditionRecord.CalcCombinations(constref AIndices: TIntegerArray): Int64; +var + i: Integer; +begin + for i in AIndices do + Write(i, ' '); + WriteLn; + + Result := 1; + i := 0; + while (Result > 0) and (i < FBlockPatterns.Count) do + begin + Result := Result * CalcCombinationsSingleBlock(FBlockPatterns[i], FDamagesBlocks[i], AIndices[i], AIndices[i + 1] - 1); + Inc(i); + end; +end; + +function TConditionRecord.CalcCombinationsSingleBlock(const APattern: string; constref ADamages: TDamages; + const AStartIndex, AStopIndex: Integer): Int64; +var + i, j, k: Integer; + indices: TIntegerArray; +begin + Write(' ', APattern, ' '); + for i := AStartIndex to AStopIndex do + Write(FValidation[i], ' '); + WriteLn; + + // No validation number assigned to this block. + if AStartIndex > AStopIndex then + begin + if ADamages.Count = 0 then + Result := 1 + else + Result := 0; + end + // One validation number assigned to this block. + else if AStartIndex = AStopIndex then + Result := CalcCombinationsSingleBlockSingleValidation(APattern, ADamages, AStartIndex) + // Multiple validation numbers assigned to this block. else begin - temp := AArrangement; - // Tries to append a dot (operational) to the current arrangement. - if (ARemainingFreeOperationalCount > 0) and TryAppendOperationalChar(temp) then + SetLength(indices, ADamages.Count); + + 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 ADamages.Count - 1 do begin - ExtendArrangement(temp, ARemainingFreeOperationalCount - 1, ACurrentValidationIndex, AArrangementCount); + WriteLn(' damage: start ',ADamages[i].Start, ', length ', ADamages[i].Length, ', remain ', ADamages[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] < ADamages[i].Start) + // Enough space after damage for the other validation numbers? + and (FValidationLengths[j, AStopIndex + 1] - FValidation[j] <= ADamages[i].CharsRemaining) + // Damage itself small enough for this validation number? + and (FValidation[j] >= ADamages[i].Length) then + Write(j - AStartIndex, ' '); + WriteLn; + end; + /////////////////////////////// + + Result := 9999; + + // Assigns validation numbers to specific damages. + j := AStartIndex; + for i := 0 to ADamages.Count - 1 do + begin + while (j <= AStopIndex) + // Enough space before damage for the other validation numbers? + and ((FValidationLengths[AStartIndex, j + 1] - FValidation[j] >= ADamages[i].Start) + // Enough space after damage for the other validation numbers? + // TODO: Is this true? Once the following check is true for given j, increasing j will not make it false, so set Result := 0 and break. + or (FValidationLengths[j, AStopIndex + 1] - FValidation[j] > ADamages[i].CharsRemaining) + // Damage itself small enough for this validation number? + or (FValidation[j] < ADamages[i].Length)) do + Inc(j); + + if (j > AStopIndex) then + begin + Result := 0; + Break; + end; + + indices[i] := j; end; - // Tries to append the current validation block (damaged) to the current arrangement. - if ACurrentValidationIndex < FValidation.Count then - begin - temp := AArrangement; - match := TryAppendValidationBlock(temp, FValidation[ACurrentValidationIndex]); + WriteLn(' validation number indices per damages:'); + Write(' '); + for i := 0 to ADamages.Count - 1 do + Write(indices[i], ' '); + Write('( '); + for i := 0 to ADamages.Count - 1 do + Write(indices[i] - AStartIndex, ' '); + WriteLn(')'); - // ... and the mandatory dot after the block, if it is not the last block. - if match - and (ACurrentValidationIndex < FValidation.Count - 1) - and not TryAppendOperationalChar(temp) then - match := False; + // TODO: Iterate over all possible assignments of validation numbers to specific damages. + end; + WriteLn(' Result: ', Result); +end; - if match then - ExtendArrangement(temp, ARemainingFreeOperationalCount, ACurrentValidationIndex + 1, AArrangementCount); +function TConditionRecord.CalcCombinationsSingleBlockSingleValidation(const APattern: string; constref ADamages: + TDamages; const AIndex: Integer): Int64; +var + combinedDamagesLength: Integer; +begin + if Length(APattern) < FValidation[AIndex] then + Result := 0 + else if ADamages.Count = 0 then + Result := Length(APattern) - FValidation[AIndex] + 1 + else begin + combinedDamagesLength := ADamages.Last.Start + ADamages.Last.Length - ADamages.First.Start; + if FValidation[AIndex] < combinedDamagesLength then + Result := 0 + else begin + Result := Min(Min(Min( + ADamages.First.Start, + FValidation[AIndex] - combinedDamagesLength + 1), + Length(APattern) - FValidation[AIndex] + 1), + ADamages.Last.CharsRemaining + 1); end; end; end; -function THotSprings.TryAppendOperationalChar(var AArrangement: string): Boolean; -begin - if FSpringPattern[Length(AArrangement) + 1] in COperationalPatternChars then - begin - AArrangement := AArrangement + COperationalChar; - Result := True; - end - else - Result := False; -end; - -function THotSprings.TryAppendValidationBlock(var AArrangement: string; const ALength: Integer): Boolean; +function TConditionRecord.ParseDamages(const APattern: string): TDamages; var i, len: Integer; + damage: TDamage; begin - Result := True; - len := Length(AArrangement); - for i := 1 to ALength do - begin - if FSpringPattern[len + i] in CDamagedPatternChars then - AArrangement := AArrangement + CDamagedChar - else begin - Result := False; - Break; + Result := TDamages.Create; + damage.Length := 0; + len := Length(APattern); + for i := 1 to len do + // The pattern must only contain damage and wildcard characters here. + if APattern[i] = CDamagedChar then + begin + if damage.Length = 0 then + damage.Start := i; + Inc(damage.Length); + end + else if damage.Length > 0 then + begin + damage.CharsRemaining := len - damage.Start - damage.Length + 1; + Result.Add(damage); + damage.Length := 0; end; + + if damage.Length > 0 then + begin + damage.CharsRemaining := 0; + Result.Add(damage); end; end; -constructor THotSprings.Create; +constructor TConditionRecord.Create; begin - FValidation := specialize TList.Create; + FBlockPatterns := TStringList.Create; + FValidation := TIntegerList.Create; + FDamagesBlocks := TDamagesBlocks.Create; end; -destructor THotSprings.Destroy; +destructor TConditionRecord.Destroy; begin + FBlockPatterns.Free; FValidation.Free; + FDamagesBlocks.Free; inherited Destroy; end; -procedure THotSprings.ProcessDataLine(const ALine: string); +procedure TConditionRecord.AddBlockPatterns(const APattern: string); var split: TStringArray; - i, j, val, maxFreeOperationalCount: Integer; + part: string; begin - FValidation.Clear; - split := ALine.Split([' ', ',']); - FSpringPattern := split[0]; + split := APattern.Split([COperationalChar]); + for part in split do + if Length(part) > 0 then + begin + FBlockPatterns.Add(part); + FDamagesBlocks.Add(ParseDamages(part)); + end; +end; - maxFreeOperationalCount := Length(FSpringPattern) - Length(split) + 2; - for i := 1 to Length(split) - 1 do - begin - val := StrToInt(split[i]); - FValidation.Add(val); - Dec(maxFreeOperationalCount, val); - end; +function TConditionRecord.GenerateBlockAssignments: Int64; +var + indices: array of Integer; + i, j, k, high: Integer; +begin + // 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. + // + // Here, 'indices[i]' denotes the index + 1 of the last validation number assigned to 'FBlockPattern[i]', and the + // index of the first validation number in 'FValidation' assigned to 'FBlockPattern[i + 1]'. If two consecutive values + // in 'indices' are the same, then the block in between has no numbers assigned to it. + // + // Note that 'indices[0] = 0' and 'indices[FBlockPatterns.Count] = FValidation.Count' are constant. Having these two + // numbers in the array simplifies the code a bit. + InitValidationLengths; + //FPatternLengths := CalcPatternLengths; + InitMinIndices; - ExtendArrangement('', maxFreeOperationalCount, 0, FPart1); - WriteLn('Part 1: ', FPart1); + SetLength(indices, FBlockPatterns.Count + 1); + high := Length(indices) - 2; + indices[0] := 0; + indices[high + 1] := FValidation.Count; + Result := 0; + k := 0; + repeat + 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(FBlockPatterns[i - 1]) do + begin + Dec(i); + Inc(indices[i]); + end; + + Inc(i); + end; + + //if FValidationLengths[indices[0], indices[1]] > Length(FBlockPatterns[0]) then + // Break; + + Result := Result + CalcCombinations(indices); + + k := high; + while (k > 0) + and ((indices[k] = FValidation.Count) + or (FValidationLengths[indices[k - 1], indices[k] + 1] > Length(FBlockPatterns[k - 1]))) do + Dec(k); + Inc(indices[k]); + until k = 0; +end; + +{ THotSprings } + +procedure THotSprings.ProcessDataLine(const ALine: string); +var + conditionRecord1, conditionRecord2: TConditionRecord; + mainSplit, split: TStringArray; + part, unfolded: string; + i: Integer; +begin + WriteLn(ALine); + WriteLn; + + conditionRecord1 := TConditionRecord.Create; + conditionRecord2 := TConditionRecord.Create; + + mainSplit := ALine.Split([' ']); + + // Adds blocks for part 1. + conditionRecord1.AddBlockPatterns(mainSplit[0]); + + // Adds blocks for part 2. + unfolded := mainSplit[0]; + for i := 2 to CPart2Repetition do + unfolded := unfolded + CWildcardChar + mainSplit[0]; + conditionRecord2.AddBlockPatterns(unfolded); + + // Adds validation numbers. + split := mainSplit[1].Split([',']); + for part in split do + conditionRecord1.Validation.Add(StrToInt(part)); for i := 1 to CPart2Repetition do - begin - FSpringPattern := FSpringPattern + CWildcardChar + split[0]; - for j := 0 to Length(split) - 2 do - FValidation.Add(FValidation[j]); - end; - maxFreeOperationalCount := (CPart2Repetition + 1) * maxFreeOperationalCount; + conditionRecord2.Validation.AddRange(conditionRecord1.Validation); - ExtendArrangement('', maxFreeOperationalCount, 0, FPart2); - WriteLn('Part 2: ', FPart2); + //for part in conditionRecord1.BlockPatterns do + // WriteLn(part); + //for i in conditionRecord1.Validation do + // WriteLn(i); + // + //WriteLn; +// +// for part in conditionRecord2.BlockPatterns do +// WriteLn(part); +// for i in conditionRecord2.Validation do +// WriteLn(i); +// WriteLn; + FPart2 := FPart2 + conditionRecord2.GenerateBlockAssignments; + + conditionRecord1.Free; + conditionRecord2.Free; + + WriteLn('------------------------'); + WriteLn; end; procedure THotSprings.Finish; From fb2f8137017acf5b8da5e11ef554cb281d7fbe2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sat, 9 Nov 2024 00:41:49 +0100 Subject: [PATCH 03/14] Added MultiIndexEnumerator --- AdventOfCode.lpi | 4 + UMultiIndexEnumerator.pas | 160 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 164 insertions(+) create mode 100644 UMultiIndexEnumerator.pas diff --git a/AdventOfCode.lpi b/AdventOfCode.lpi index 2a9af4b..71cbad7 100644 --- a/AdventOfCode.lpi +++ b/AdventOfCode.lpi @@ -157,6 +157,10 @@ + + + + diff --git a/UMultiIndexEnumerator.pas b/UMultiIndexEnumerator.pas new file mode 100644 index 0000000..ca02c55 --- /dev/null +++ b/UMultiIndexEnumerator.pas @@ -0,0 +1,160 @@ +{ + Solutions to the Advent Of Code. + Copyright (C) 2024 Stefan Müller + + This program is free software: you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any later + version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along with + this program. If not, see . +} + +unit UMultiIndexEnumerator; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils; + +type + TIndexArray = array of Integer; + + TIndexValidationResult = (ivrValid, ivrSkip, ivrBacktrack); + + TEnumerableMultiIndexStrategy = class; + + { TMultiIndexEnumerator } + + TMultiIndexEnumerator = class(TInterfacedObject, specialize IEnumerator) + private + FStrategy: TEnumerableMultiIndexStrategy; + FCurrent: TIndexArray; + FMustInit: Boolean; + function UpdateArray(const AInit: Boolean): Boolean; + public + constructor Create(const AStrategy: TEnumerableMultiIndexStrategy); + function GetCurrent: TIndexArray; + function MoveNext: Boolean; + procedure Reset; + property Current: TIndexArray read GetCurrent; + end; + + { TEnumerableMultiIndexStrategy } + + TEnumerableMultiIndexStrategy = class(TInterfacedObject, specialize IEnumerable) + public + function GetEnumerator: specialize IEnumerator; + function GetCardinality: Integer; virtual; abstract; + function TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer; + out AStartIndexValue: Integer): Boolean; virtual; abstract; + function ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): + TIndexValidationResult; virtual; abstract; + end; + +implementation + +{ TMultiIndexEnumerator } + +function TMultiIndexEnumerator.UpdateArray(const AInit: Boolean): Boolean; +var + i, initialized: Integer; + r: TIndexValidationResult; +begin + if AInit then + begin + i := 0; + initialized := -1; + end + else begin + i := Length(FCurrent) - 1; + initialized := i; + end; + + while i < Length(FCurrent) do + begin + if initialized < i then + begin + // Checks whether start index value can be set, and backtracks or aborts if not. + if not FStrategy.TryGetStartIndexValue(FCurrent, i, FCurrent[i]) then + if i > 0 then + begin + Dec(i); + Continue; + end + else begin + Result := False; + Exit; + end + end + else + // Sets next candidate for current index value. + Inc(FCurrent[i]); + + // Checks if current index value is valid, and increases it until it is, or backtracks or aborts if so indicated. + while True do + begin + r := FStrategy.ValidateIndexValue(FCurrent, i); + case r of + ivrValid: begin + initialized := i; + Inc(i); + Break; + end; + ivrSkip: + Inc(FCurrent[i]); + ivrBacktrack: + if i > 0 then + begin + Dec(i); + Break; + end + else begin + Result := False; + Exit; + end; + end; + end; + end; + Result := True; +end; + +constructor TMultiIndexEnumerator.Create(const AStrategy: TEnumerableMultiIndexStrategy); +begin + FStrategy := AStrategy; + SetLength(FCurrent, FStrategy.GetCardinality); + Reset; +end; + +function TMultiIndexEnumerator.GetCurrent: TIndexArray; +begin + Result := FCurrent; +end; + +function TMultiIndexEnumerator.MoveNext: Boolean; +begin + Result := UpdateArray(FMustInit); + FMustInit := False; +end; + +procedure TMultiIndexEnumerator.Reset; +begin + FMustInit := True; +end; + +{ TEnumerableMultiIndexStrategy } + +function TEnumerableMultiIndexStrategy.GetEnumerator: specialize IEnumerator; +begin + Result := TMultiIndexEnumerator.Create(Self); +end; + +end. + From 1d399cc5b60fd1cf10253ce0d8bd848652b0d307 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sat, 9 Nov 2024 00:42:11 +0100 Subject: [PATCH 04/14] Updated day 12 WIP solver --- solvers/UHotSprings.pas | 418 ++++++++++++++++++++++++++++++++-------- 1 file changed, 337 insertions(+), 81 deletions(-) diff --git a/solvers/UHotSprings.pas b/solvers/UHotSprings.pas index e155e57..601823f 100644 --- a/solvers/UHotSprings.pas +++ b/solvers/UHotSprings.pas @@ -22,7 +22,7 @@ unit UHotSprings; interface uses - Classes, SysUtils, Math, Generics.Collections, USolver, UCommon; + Classes, SysUtils, Math, Generics.Collections, USolver, UCommon, UMultiIndexEnumerator; const COperationalChar = '.'; @@ -30,7 +30,7 @@ const CWildcardChar = '?'; //COperationalPatternChars = [COperationalChar, CWildcardChar]; //CDamagedPatternChars = [CDamagedChar, CWildcardChar]; - CPart2Repetition = 2; + CPart2Repetition = 1; type @@ -52,6 +52,7 @@ type TValidationLengths = array of array of Integer; //TPatternLengths = array of Integer; + // TODO: TIntegerArray probably not needed. TIntegerArray = array of Integer; { TDamage } @@ -61,16 +62,62 @@ type end; TDamages = specialize TList; + // TODO: Instead of using TDamagesBlocks, "block" should be a record of a string and its associated list TDamages. TDamagesBlocks = specialize TObjectList; + { TValidationToDamageAssignments } + + TValidationToDamageAssignments = class(TEnumerableMultiIndexStrategy) + private + FValidation: TIntegerList; + FValidationLengths: TValidationLengths; + FDamages: TDamages; + FValidationStartIndex, FValidationStopIndex: Integer; + // Calculates "span", the length of all damages for this validation number combined. + function CalcValidationSpan(constref ACurrentIndexArray: TIndexArray; const ALastDamageIndex, AValidationNumber: + Integer): Integer; + public + constructor Create(constref AValidation: TIntegerList; constref AValidationLengths: TValidationLengths; + constref ADamages: TDamages; const AStartIndex, AStopIndex: Integer); + function GetCardinality: Integer; override; + function TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer; + out AStartIndexValue: Integer): Boolean; override; + function ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): + TIndexValidationResult; override; + end; + + { TValidationPositionInfo } + + TValidationPositionInfo = record + ValidationIndex: Integer; + MinStart, MaxStart: Byte; + end; + + TValidationPositionInfos = specialize TList; + + { TValidationPositionOffsets } + + TValidationPositionOffsets = class(TEnumerableMultiIndexStrategy) + private + FValidation: TIntegerList; + FPositionInfos: TValidationPositionInfos; + public + constructor Create(constref AValidation: TIntegerList; constref APositionInfos: TValidationPositionInfos); + function GetCardinality: Integer; override; + function TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer; + out AStartIndexValue: Integer): Boolean; override; + function ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): + TIndexValidationResult; override; + end; + { TConditionRecord } TConditionRecord = class private FValidation: TIntegerList; - // List of non-empty, maximum-length parts of the pattern without operational springs. - FBlockPatterns: TStringList; - // Array 'a' of accumulated validation block lengths. 'a[i, j]' denotes the combined length of consecutive + // List of non-empty, maximum-length parts of the pattern without operational springs ("blocks"). + FBlocks: TStringList; + // Array 'a' of accumulated validation series lengths. 'a[i, j]' denotes the combined length of consecutive // validation numbers from 'FValidation[i]' to 'FValidation[j - 1]' with a single space in between each pair of // them. FValidationLengths: TValidationLengths; @@ -78,34 +125,39 @@ type //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 block patterns starting at 'FBlockPatterns[i]'. + // cannot fit into the remaining blocks starting at 'FBlocks[i]'. FMinIndices: TIntegerArray; - // List 'a' of lists of damages in a block pattern. Each list of damages 'a[i]' contains exactly one entry for each - // block of consecutive damages characters in the i-th block pattern. + // List 'a' of lists of damages in a block. Each list of damages 'a[i]' contains exactly one entry for each block of + // consecutive damages characters in the i-th block. // For example, if the pattern is '?#.??##?#?..??', then 'FDamagesBlocks' would have 3 entries, which are lists of // 1, 2, and 0 damages, respectively. FDamagesBlocks: TDamagesBlocks; procedure InitValidationLengths; - //// Returns an array 'a' of accumulated pattern block lengths. 'a[i]' denotes the combined length of consecutive - //// pattern blocks starting with 'FBlockPatterns[i]' and all following with a single space in between each pair of + //// 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 CalcCombinationsSingleBlock(const APattern: string; constref ADamages: TDamages; const AStartIndex, - AStopIndex: Integer): Int64; - function CalcCombinationsSingleBlockSingleValidation(const APattern: string; constref ADamages: TDamages; + function CalcCombinationsBlock(const ABlock: string; constref ADamages: TDamages; const AStartIndex, AStopIndex: + Integer): Int64; + function CalcCombinationsBlockSingleValidation(const ABlockLength: Integer; constref ADamages: TDamages; const AIndex: Integer): Int64; - function ParseDamages(const APattern: string): TDamages; + function CalcCombinationsBlockMultiValidations(const ABlockLength: Integer; constref ADamages: TDamages; + constref AIndices: TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; + function CalcCombinationsBlockAssignedValidations(const ABlockLength: Integer; constref APositionInfos: + TValidationPositionInfos; constref AOffsets: TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; + function ParseDamages(const ABlock: string): TDamages; public - property BlockPatterns: TStringList read FBlockPatterns; + property Blocks: TStringList read FBlocks; property Validation: TIntegerList read FValidation; constructor Create; destructor Destroy; override; - // Adds all non-empty, maximum-length parts of the pattern without operational springs. - procedure AddBlockPatterns(const APattern: string); + // Adds all non-empty, maximum-length parts of the pattern without operational springs ("blocks"). + procedure AddBlocks(const APattern: string); function GenerateBlockAssignments: Int64; end; @@ -146,6 +198,137 @@ implementation // Write(' |'); //end; +{ TValidationToDamageAssignments } + +function TValidationToDamageAssignments.CalcValidationSpan(constref ACurrentIndexArray: TIndexArray; + const ALastDamageIndex, AValidationNumber: Integer): Integer; +var + spanStart: Integer; +begin + spanStart := ALastDamageIndex; + while (spanStart > 0) and (ACurrentIndexArray[spanStart - 1] = AValidationNumber) do + Dec(spanStart); + Result := FDamages[ALastDamageIndex].Length; + if spanStart < ALastDamageIndex then + Inc(Result, FDamages[ALastDamageIndex].Start - FDamages[spanStart].Start); +end; + +constructor TValidationToDamageAssignments.Create(constref AValidation: TIntegerList; constref AValidationLengths: + TValidationLengths; constref ADamages: TDamages; const AStartIndex, AStopIndex: Integer); +begin + FValidation := AValidation; + FValidationLengths := AValidationLengths; + FDamages := ADamages; + FValidationStartIndex := AStartIndex; + FValidationStopIndex := AStopIndex; +end; + +function TValidationToDamageAssignments.GetCardinality: Integer; +begin + Result := FDamages.Count; +end; + +function TValidationToDamageAssignments.TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; + const ACurrentIndex: Integer; out AStartIndexValue: Integer): Boolean; +begin + Result := True; + if ACurrentIndex > 0 then + AStartIndexValue := ACurrentIndexArray[ACurrentIndex - 1] + else + AStartIndexValue := FValidationStartIndex; +end; + +function TValidationToDamageAssignments.ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; + const ACurrentIndex: Integer): TIndexValidationResult; +var + i, prev, firstSkip: Integer; +begin + i := ACurrentIndexArray[ACurrentIndex]; + if i > FValidationStopIndex then + begin + Result := ivrBacktrack; + Exit; + 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 + 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 + begin + Result := ivrBacktrack; + Exit; + end; + + // Checks if there is enough space between previous and this damage for skipped validation numbers. + if ACurrentIndex > 0 then + begin + prev := ACurrentIndex - 1; + firstSkip := ACurrentIndexArray[prev] + 1; + if (firstSkip < i) and (FValidationLengths[firstSkip, i] + 2 > FDamages[ACurrentIndex].Start - FDamages[prev].Start - FDamages[prev].Length) then + begin + Result := ivrBacktrack; + Exit; + end; + end; + + // Checks if span is small enough to fit within this validation number. + if FValidation[i] < CalcValidationSpan(ACurrentIndexArray, ACurrentIndex, i) then + begin + Result := ivrSkip; + Exit; + end; + + Result := ivrValid; +end; + +{ TValidationPositionOffsets } + +constructor TValidationPositionOffsets.Create(constref AValidation: TIntegerList; constref APositionInfos: + TValidationPositionInfos); +begin + FValidation := AValidation; + FPositionInfos := APositionInfos; +end; + +function TValidationPositionOffsets.GetCardinality: Integer; +begin + Result := FPositionInfos.Count; +end; + +function TValidationPositionOffsets.TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; + const ACurrentIndex: Integer; out AStartIndexValue: Integer): Boolean; +var + info: TValidationPositionInfo; +begin + info := FPositionInfos[ACurrentIndex]; + // 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 + AStartIndexValue := Max(AStartIndexValue, + ACurrentIndexArray[ACurrentIndex - 1] + FValidation[FPositionInfos[ACurrentIndex - 1].ValidationIndex] + 1); + Result := True; +end; + +function TValidationPositionOffsets.ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: + Integer): TIndexValidationResult; +begin + if ACurrentIndexArray[ACurrentIndex] <= FPositionInfos[ACurrentIndex].MaxStart then + Result := ivrValid + else + Result := ivrBacktrack; +end; + { TConditionRecord } procedure TConditionRecord.InitValidationLengths; @@ -179,15 +362,15 @@ procedure TConditionRecord.InitMinIndices; var i, j, patternsLength: Integer; begin - SetLength(FMinIndices, FBlockPatterns.Count - 1); - patternsLength := Length(FBlockPatterns[FBlockPatterns.Count - 1]); + SetLength(FMinIndices, FBlocks.Count - 1); + patternsLength := Length(FBlocks[FBlocks.Count - 1]); j := FValidation.Count; - for i := FBlockPatterns.Count - 2 downto 0 do + for i := FBlocks.Count - 2 downto 0 do begin while (j >= 0) and (FValidationLengths[j, FValidation.Count] <= patternsLength) do Dec(j); FMinIndices[i] := j + 1; - patternsLength := patternsLength + 1 + Length(FBlockPatterns[i]); + patternsLength := patternsLength + 1 + Length(FBlocks[i]); end; end; @@ -201,20 +384,21 @@ begin Result := 1; i := 0; - while (Result > 0) and (i < FBlockPatterns.Count) do + while (Result > 0) and (i < FBlocks.Count) do begin - Result := Result * CalcCombinationsSingleBlock(FBlockPatterns[i], FDamagesBlocks[i], AIndices[i], AIndices[i + 1] - 1); + Result := Result * CalcCombinationsBlock(FBlocks[i], FDamagesBlocks[i], AIndices[i], AIndices[i + 1] - 1); Inc(i); end; end; -function TConditionRecord.CalcCombinationsSingleBlock(const APattern: string; constref ADamages: TDamages; - const AStartIndex, AStopIndex: Integer): Int64; +function TConditionRecord.CalcCombinationsBlock(const ABlock: string; constref ADamages: TDamages; const AStartIndex, + AStopIndex: Integer): Int64; var i, j, k: Integer; - indices: TIntegerArray; + indices: TIndexArray; + validationToDamageAssignments: TValidationToDamageAssignments; begin - Write(' ', APattern, ' '); + Write(' ', ABlock, ' '); for i := AStartIndex to AStopIndex do Write(FValidation[i], ' '); WriteLn; @@ -229,11 +413,10 @@ begin end // One validation number assigned to this block. else if AStartIndex = AStopIndex then - Result := CalcCombinationsSingleBlockSingleValidation(APattern, ADamages, AStartIndex) + Result := CalcCombinationsBlockSingleValidation(Length(ABlock), ADamages, AStartIndex) // Multiple validation numbers assigned to this block. else begin - SetLength(indices, ADamages.Count); - + /////////////////////////////// Write(' min before: '); for i := AStartIndex to AStopIndex do Write(FValidationLengths[AStartIndex, i + 1] - FValidation[i], ' '); @@ -243,7 +426,6 @@ begin Write(FValidationLengths[i, AStopIndex + 1] - FValidation[i], ' '); WriteLn; - /////////////////////////////// for i := 0 to ADamages.Count - 1 do begin WriteLn(' damage: start ',ADamages[i].Start, ', length ', ADamages[i].Length, ', remain ', ADamages[i].CharsRemaining); @@ -263,51 +445,34 @@ begin Result := 9999; // Assigns validation numbers to specific damages. - j := AStartIndex; - for i := 0 to ADamages.Count - 1 do + validationToDamageAssignments := TValidationToDamageAssignments.Create(FValidation, FValidationLengths, ADamages, + AStartIndex, AStopIndex); + WriteLn(' validation numbers (indices) per damages:'); + for indices in validationToDamageAssignments do begin - while (j <= AStopIndex) - // Enough space before damage for the other validation numbers? - and ((FValidationLengths[AStartIndex, j + 1] - FValidation[j] >= ADamages[i].Start) - // Enough space after damage for the other validation numbers? - // TODO: Is this true? Once the following check is true for given j, increasing j will not make it false, so set Result := 0 and break. - or (FValidationLengths[j, AStopIndex + 1] - FValidation[j] > ADamages[i].CharsRemaining) - // Damage itself small enough for this validation number? - or (FValidation[j] < ADamages[i].Length)) do - Inc(j); - - if (j > AStopIndex) then - begin - Result := 0; - Break; - end; - - indices[i] := j; + Write(' '); + for i := 0 to ADamages.Count - 1 do + Write(FValidation[indices[i]], ' '); + Write('( '); + for i := 0 to ADamages.Count - 1 do + Write(indices[i] - AStartIndex, ' '); + WriteLn(')'); + CalcCombinationsBlockMultiValidations(Length(ABlock), ADamages, indices, AStartIndex, AStopIndex); end; - - WriteLn(' validation number indices per damages:'); - Write(' '); - for i := 0 to ADamages.Count - 1 do - Write(indices[i], ' '); - Write('( '); - for i := 0 to ADamages.Count - 1 do - Write(indices[i] - AStartIndex, ' '); - WriteLn(')'); - - // TODO: Iterate over all possible assignments of validation numbers to specific damages. + validationToDamageAssignments.Free; end; WriteLn(' Result: ', Result); end; -function TConditionRecord.CalcCombinationsSingleBlockSingleValidation(const APattern: string; constref ADamages: +function TConditionRecord.CalcCombinationsBlockSingleValidation(const ABlockLength: Integer; constref ADamages: TDamages; const AIndex: Integer): Int64; var combinedDamagesLength: Integer; begin - if Length(APattern) < FValidation[AIndex] then + if ABlockLength < FValidation[AIndex] then Result := 0 else if ADamages.Count = 0 then - Result := Length(APattern) - FValidation[AIndex] + 1 + Result := ABlockLength - FValidation[AIndex] + 1 else begin combinedDamagesLength := ADamages.Last.Start + ADamages.Last.Length - ADamages.First.Start; if FValidation[AIndex] < combinedDamagesLength then @@ -316,23 +481,113 @@ begin Result := Min(Min(Min( ADamages.First.Start, FValidation[AIndex] - combinedDamagesLength + 1), - Length(APattern) - FValidation[AIndex] + 1), + ABlockLength - FValidation[AIndex] + 1), ADamages.Last.CharsRemaining + 1); end; end; end; -function TConditionRecord.ParseDamages(const APattern: string): TDamages; +function TConditionRecord.CalcCombinationsBlockMultiValidations(const ABlockLength: Integer; constref ADamages: + TDamages; constref AIndices: TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; +var + i, high: Integer; + position: TValidationPositionInfo; + positions: TValidationPositionInfos; + validationPositionOffsets: TValidationPositionOffsets; + offsets: TIndexArray; +begin + positions := TValidationPositionInfos.Create; + high := Length(AIndices) - 1; + // Initializes first info record. + position.ValidationIndex := AIndices[0]; + position.MaxStart := ADamages[0].Start; + position.MinStart := 1; + for i := 1 to high do + if AIndices[i] <> position.ValidationIndex then + 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); + positions.Add(position); + // Initializes next info record. + position.ValidationIndex := AIndices[i]; + position.MaxStart := ADamages[i].Start; + position.MinStart := position.MinStart + FValidation[position.ValidationIndex] + 1; + end; + // Finalizes last info record. + position.MaxStart := Min(position.MaxStart, ABlockLength + 1 - FValidation[position.ValidationIndex]); + position.MinStart := Max(position.MinStart, + ADamages[high].Start + ADamages[high].Length - FValidation[position.ValidationIndex]); + positions.Add(position); + + WriteLn(' validation position infos'); + for position in positions do + WriteLn(' ', position.ValidationIndex, ' ', position.MinStart, ' ', position.MaxStart); + + WriteLn(' offsets'); + validationPositionOffsets := TValidationPositionOffsets.Create(FValidation, positions); + for offsets in validationPositionOffsets do + CalcCombinationsBlockAssignedValidations(ABlockLength, positions, offsets, AStartIndex, AStopIndex); + validationPositionOffsets.Free; + + positions.Free; +end; + +function TConditionRecord.CalcCombinationsBlockAssignedValidations(const ABlockLength: Integer; constref APositionInfos: + TValidationPositionInfos; constref AOffsets: TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; +var + i, space, freedom, count: Integer; +begin + Write(' '); + for i in AOffsets do + Write(i, ' '); + + Write(' count/space/freedom: '); + // TODO: Number of combinations is binom(count + freedom, freedom). + if AStartIndex < APositionInfos[0].ValidationIndex then + begin + count := APositionInfos[0].ValidationIndex - AStartIndex; + space := AOffsets[0] - 2; + freedom := space - FValidationLengths[AStartIndex, APositionInfos[0].ValidationIndex]; + Write(count, '/', space, '/', freedom, ' '); + end + else + Write('X '); + for i := 0 to APositionInfos.Count - 2 do + if APositionInfos[i].ValidationIndex + 1 < APositionInfos[i + 1].ValidationIndex then + begin + count := APositionInfos[i + 1].ValidationIndex - APositionInfos[i].ValidationIndex - 1; + space := AOffsets[i + 1] - AOffsets[i] - FValidation[APositionInfos[i].ValidationIndex] - 2; + freedom := space - FValidationLengths[APositionInfos[i].ValidationIndex + 1, APositionInfos[i + 1].ValidationIndex]; + Write(count, '/', space, '/', freedom, ' '); + end + else + Write('X '); + if APositionInfos.Last.ValidationIndex < AStopIndex then + begin + count := AStopIndex - APositionInfos.Last.ValidationIndex; + space := ABlockLength - AOffsets[APositionInfos.Count - 1] - FValidation[APositionInfos.Last.ValidationIndex]; + freedom := space - FValidationLengths[APositionInfos.Last.ValidationIndex + 1, AStopIndex + 1]; + Write(count, '/', space, '/', freedom, ' '); + end + else + Write('X '); + + WriteLn; +end; + +function TConditionRecord.ParseDamages(const ABlock: string): TDamages; var i, len: Integer; damage: TDamage; begin Result := TDamages.Create; damage.Length := 0; - len := Length(APattern); + len := Length(ABlock); for i := 1 to len do // The pattern must only contain damage and wildcard characters here. - if APattern[i] = CDamagedChar then + if ABlock[i] = CDamagedChar then begin if damage.Length = 0 then damage.Start := i; @@ -354,20 +609,20 @@ end; constructor TConditionRecord.Create; begin - FBlockPatterns := TStringList.Create; + FBlocks := TStringList.Create; FValidation := TIntegerList.Create; FDamagesBlocks := TDamagesBlocks.Create; end; destructor TConditionRecord.Destroy; begin - FBlockPatterns.Free; + FBlocks.Free; FValidation.Free; FDamagesBlocks.Free; inherited Destroy; end; -procedure TConditionRecord.AddBlockPatterns(const APattern: string); +procedure TConditionRecord.AddBlocks(const APattern: string); var split: TStringArray; part: string; @@ -376,7 +631,7 @@ begin for part in split do if Length(part) > 0 then begin - FBlockPatterns.Add(part); + FBlocks.Add(part); FDamagesBlocks.Add(ParseDamages(part)); end; end; @@ -399,11 +654,12 @@ begin //FPatternLengths := CalcPatternLengths; InitMinIndices; - SetLength(indices, FBlockPatterns.Count + 1); + SetLength(indices, FBlocks.Count + 1); high := Length(indices) - 2; indices[0] := 0; indices[high + 1] := FValidation.Count; + // TODO: Use TMultiIndexEnumerator for this. Result := 0; k := 0; repeat @@ -419,7 +675,7 @@ begin //WriteLn(j, ' ', FMinIndices[i - 1]); indices[i] := Max(indices[i - 1], FMinIndices[i - 1]); - while FValidationLengths[indices[i - 1], indices[i]] > Length(FBlockPatterns[i - 1]) do + while FValidationLengths[indices[i - 1], indices[i]] > Length(FBlocks[i - 1]) do begin Dec(i); Inc(indices[i]); @@ -428,7 +684,7 @@ begin Inc(i); end; - //if FValidationLengths[indices[0], indices[1]] > Length(FBlockPatterns[0]) then + //if FValidationLengths[indices[0], indices[1]] > Length(FBlocks[0]) then // Break; Result := Result + CalcCombinations(indices); @@ -436,7 +692,7 @@ begin k := high; while (k > 0) and ((indices[k] = FValidation.Count) - or (FValidationLengths[indices[k - 1], indices[k] + 1] > Length(FBlockPatterns[k - 1]))) do + or (FValidationLengths[indices[k - 1], indices[k] + 1] > Length(FBlocks[k - 1]))) do Dec(k); Inc(indices[k]); until k = 0; @@ -460,13 +716,13 @@ begin mainSplit := ALine.Split([' ']); // Adds blocks for part 1. - conditionRecord1.AddBlockPatterns(mainSplit[0]); + conditionRecord1.AddBlocks(mainSplit[0]); // Adds blocks for part 2. unfolded := mainSplit[0]; for i := 2 to CPart2Repetition do unfolded := unfolded + CWildcardChar + mainSplit[0]; - conditionRecord2.AddBlockPatterns(unfolded); + conditionRecord2.AddBlocks(unfolded); // Adds validation numbers. split := mainSplit[1].Split([',']); @@ -475,14 +731,14 @@ begin for i := 1 to CPart2Repetition do conditionRecord2.Validation.AddRange(conditionRecord1.Validation); - //for part in conditionRecord1.BlockPatterns do + //for part in conditionRecord1.Blocks do // WriteLn(part); //for i in conditionRecord1.Validation do // WriteLn(i); // //WriteLn; // -// for part in conditionRecord2.BlockPatterns do +// for part in conditionRecord2.Blocks do // WriteLn(part); // for i in conditionRecord2.Validation do // WriteLn(i); @@ -498,7 +754,7 @@ end; procedure THotSprings.Finish; begin - + ProcessDataLine('?????#??##??????#??????? 5,3,1,2,1'); end; function THotSprings.GetDataFileName: string; From be0357befd05e0791673dba28cf0ddbcfd554f97 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sat, 9 Nov 2024 17:59:56 +0100 Subject: [PATCH 05/14] Added binomial coefficient calculation --- AdventOfCode.lpi | 4 + UBinomialCoefficients.pas | 93 +++++++++++++++ tests/AdventOfCodeFPCUnit.lpi | 4 + tests/AdventOfCodeFPCUnit.lpr | 2 +- tests/UBinomialCoefficientsTestCases.pas | 138 +++++++++++++++++++++++ 5 files changed, 240 insertions(+), 1 deletion(-) create mode 100644 UBinomialCoefficients.pas create mode 100644 tests/UBinomialCoefficientsTestCases.pas diff --git a/AdventOfCode.lpi b/AdventOfCode.lpi index 71cbad7..74c9eb4 100644 --- a/AdventOfCode.lpi +++ b/AdventOfCode.lpi @@ -161,6 +161,10 @@ + + + + diff --git a/UBinomialCoefficients.pas b/UBinomialCoefficients.pas new file mode 100644 index 0000000..1d4e875 --- /dev/null +++ b/UBinomialCoefficients.pas @@ -0,0 +1,93 @@ +{ + Solutions to the Advent Of Code. + Copyright (C) 2024 Stefan Müller + + This program is free software: you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any later + version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along with + this program. If not, see . +} + +unit UBinomialCoefficients; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, Generics.Collections; + +type + TCardinalArray = array of Cardinal; + TCardinalArrays = specialize TList; + + { TBinomialCoefficientCache } + + TBinomialCoefficientCache = class + private + FCache: TCardinalArrays; + procedure AddRow; + public + constructor Create; + destructor Destroy; override; + function Get(const AN, AK: Cardinal): Cardinal; + function GetCachedRowsCount: Cardinal; + end; + +implementation + +{ TBinomialCoefficientCache } + +procedure TBinomialCoefficientCache.AddRow; +var + row: TCardinalArray; + i: Cardinal; +begin + SetLength(row, FCache.Count + 1); + row[0] := 1; + if FCache.Count > 0 then + begin + row[FCache.Count] := 1; + for i := 1 to FCache.Count - 1 do + row[i] := FCache.Last[i - 1] + FCache.Last[i]; + end; + FCache.Add(row); +end; + +constructor TBinomialCoefficientCache.Create; +begin + FCache := TCardinalArrays.Create; +end; + +destructor TBinomialCoefficientCache.Destroy; +begin + FCache.Free; + inherited Destroy; +end; + +function TBinomialCoefficientCache.Get(const AN, AK: Cardinal): Cardinal; +var + i: Cardinal; +begin + if AN < AK then + raise ERangeError.Create('Cannot calculate binomial coefficient "n choose k" with k larger than n.'); + + for i := FCache.Count to AN do + AddRow; + Result := FCache[AN][AK]; +end; + +function TBinomialCoefficientCache.GetCachedRowsCount: Cardinal; +begin + Result := FCache.Count; +end; + +end. + diff --git a/tests/AdventOfCodeFPCUnit.lpi b/tests/AdventOfCodeFPCUnit.lpi index 0d0c019..7ee1927 100644 --- a/tests/AdventOfCodeFPCUnit.lpi +++ b/tests/AdventOfCodeFPCUnit.lpi @@ -152,6 +152,10 @@ + + + + diff --git a/tests/AdventOfCodeFPCUnit.lpr b/tests/AdventOfCodeFPCUnit.lpr index 2c2a60e..4b270c1 100644 --- a/tests/AdventOfCodeFPCUnit.lpr +++ b/tests/AdventOfCodeFPCUnit.lpr @@ -10,7 +10,7 @@ uses UFloorWillBeLavaTestCases, UClumsyCrucibleTestCases, ULavaductLagoonTestCases, UAplentyTestCases, UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases, ULongWalkTestCases, UNeverTellMeTheOddsTestCases, USnowverloadTestCases, UBigIntTestCases, UPolynomialTestCases, - UPolynomialRootsTestCases; + UPolynomialRootsTestCases, UBinomialCoefficientsTestCases; {$R *.res} diff --git a/tests/UBinomialCoefficientsTestCases.pas b/tests/UBinomialCoefficientsTestCases.pas new file mode 100644 index 0000000..4de87b4 --- /dev/null +++ b/tests/UBinomialCoefficientsTestCases.pas @@ -0,0 +1,138 @@ +{ + Solutions to the Advent Of Code. + Copyright (C) 2024 Stefan Müller + + This program is free software: you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any later + version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along with + this program. If not, see . +} + +unit UBinomialCoefficientsTestCases; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testregistry, UBinomialCoefficients; + +type + + { TBinomialCoefficientsTestCase } + + TBinomialCoefficientsTestCase = class(TTestCase) + private + FBinomialCoefficientCache: TBinomialCoefficientCache; + procedure RunRangeError; + procedure AssertEqualsCalculation(const AN, AK, AExpected: Cardinal); + procedure AssertEqualsCachedRowsCount(const AExpected: Cardinal); + protected + procedure SetUp; override; + procedure TearDown; override; + published + procedure TestZeroChooseZero; + procedure TestNChooseZero; + procedure TestNChooseN; + procedure TestNChooseK; + procedure TestCombined; + procedure TestFullRow; + procedure TestRangeError; + end; + +implementation + +{ TBinomialCoefficientsTestCase } + +procedure TBinomialCoefficientsTestCase.RunRangeError; +begin + FBinomialCoefficientCache.Get(1, 5); +end; + +procedure TBinomialCoefficientsTestCase.AssertEqualsCalculation(const AN, AK, AExpected: Cardinal); +begin + AssertEquals('Unexpected calculation result', AExpected, FBinomialCoefficientCache.Get(AN, AK)); +end; + +procedure TBinomialCoefficientsTestCase.AssertEqualsCachedRowsCount(const AExpected: Cardinal); +begin + AssertEquals('Unexpected cached rows count', AExpected, FBinomialCoefficientCache.GetCachedRowsCount); +end; + +procedure TBinomialCoefficientsTestCase.SetUp; +begin + FBinomialCoefficientCache := TBinomialCoefficientCache.Create; +end; + +procedure TBinomialCoefficientsTestCase.TearDown; +begin + FBinomialCoefficientCache.Free; +end; + +procedure TBinomialCoefficientsTestCase.TestZeroChooseZero; +begin + AssertEqualsCalculation(0, 0, 1); + AssertEqualsCachedRowsCount(1); +end; + +procedure TBinomialCoefficientsTestCase.TestNChooseZero; +begin + AssertEqualsCalculation(15, 0, 1); + AssertEqualsCachedRowsCount(16); +end; + +procedure TBinomialCoefficientsTestCase.TestNChooseN; +begin + AssertEqualsCalculation(11, 11, 1); + AssertEqualsCachedRowsCount(12); +end; + +procedure TBinomialCoefficientsTestCase.TestNChooseK; +begin + AssertEqualsCalculation(8, 3, 56); + AssertEqualsCachedRowsCount(9); +end; + +procedure TBinomialCoefficientsTestCase.TestCombined; +begin + AssertEqualsCalculation(5, 1, 5); + AssertEqualsCachedRowsCount(6); + AssertEqualsCalculation(8, 4, 70); + AssertEqualsCachedRowsCount(9); + AssertEqualsCalculation(3, 1, 3); + AssertEqualsCachedRowsCount(9); +end; + +procedure TBinomialCoefficientsTestCase.TestFullRow; +begin + AssertEqualsCalculation(5, 0, 1); + AssertEqualsCachedRowsCount(6); + AssertEqualsCalculation(5, 1, 5); + AssertEqualsCachedRowsCount(6); + AssertEqualsCalculation(5, 2, 10); + AssertEqualsCachedRowsCount(6); + AssertEqualsCalculation(5, 3, 10); + AssertEqualsCachedRowsCount(6); + AssertEqualsCalculation(5, 4, 5); + AssertEqualsCachedRowsCount(6); + AssertEqualsCalculation(5, 5, 1); + AssertEqualsCachedRowsCount(6); +end; + +procedure TBinomialCoefficientsTestCase.TestRangeError; +begin + AssertException(ERangeError, @RunRangeError); +end; + +initialization + + RegisterTest('Helper', TBinomialCoefficientsTestCase); +end. + From 21ef4c08f1e8d1bfd56d7fa1726c1afe5b10d877 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sat, 9 Nov 2024 23:11:05 +0100 Subject: [PATCH 06/14] Added TBinomialCoefficientCache method documentation --- UBinomialCoefficients.pas | 3 +++ 1 file changed, 3 insertions(+) diff --git a/UBinomialCoefficients.pas b/UBinomialCoefficients.pas index 1d4e875..96b9ff6 100644 --- a/UBinomialCoefficients.pas +++ b/UBinomialCoefficients.pas @@ -37,7 +37,10 @@ type public constructor Create; destructor Destroy; override; + // Returns N choose K, with N >= K >= 0. function Get(const AN, AK: Cardinal): Cardinal; + // Returns the number of cached rows C = N + 1, where N is the highest from previously queried "N choose K". The + // actual number of cached binomial coefficient values is C * (C + 1) / 2. function GetCachedRowsCount: Cardinal; end; From 60ef49c1eebf456d90fa5c0edd076b28d81c1cc0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sat, 9 Nov 2024 23:17:47 +0100 Subject: [PATCH 07/14] Updated day 12 WIP solver --- solvers/UHotSprings.pas | 109 +++++++++++++++++++++++++--------------- 1 file changed, 69 insertions(+), 40 deletions(-) diff --git a/solvers/UHotSprings.pas b/solvers/UHotSprings.pas index 601823f..70d0902 100644 --- a/solvers/UHotSprings.pas +++ b/solvers/UHotSprings.pas @@ -22,7 +22,7 @@ unit UHotSprings; interface uses - Classes, SysUtils, Math, Generics.Collections, USolver, UCommon, UMultiIndexEnumerator; + Classes, SysUtils, Math, Generics.Collections, USolver, UCommon, UMultiIndexEnumerator, UBinomialCoefficients; const COperationalChar = '.'; @@ -114,6 +114,7 @@ type TConditionRecord = class private + FBinomialCoefficients: TBinomialCoefficientCache; FValidation: TIntegerList; // List of non-empty, maximum-length parts of the pattern without operational springs ("blocks"). FBlocks: TStringList; @@ -150,11 +151,12 @@ type constref AIndices: TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; function CalcCombinationsBlockAssignedValidations(const ABlockLength: Integer; constref APositionInfos: TValidationPositionInfos; constref AOffsets: TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; + function CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer): Int64; function ParseDamages(const ABlock: string): TDamages; public property Blocks: TStringList read FBlocks; property Validation: TIntegerList read FValidation; - constructor Create; + constructor Create(constref ABinomialCoefficients: TBinomialCoefficientCache); destructor Destroy; override; // Adds all non-empty, maximum-length parts of the pattern without operational springs ("blocks"). procedure AddBlocks(const APattern: string); @@ -164,7 +166,12 @@ type { THotSprings } THotSprings = class(TSolver) + private + // Keeping the binomial coefficients calculator here so it can be shared for all lines. + FBinomialCoefficients: TBinomialCoefficientCache; public + constructor Create; + destructor Destroy; override; procedure ProcessDataLine(const ALine: string); override; procedure Finish; override; function GetDataFileName: string; override; @@ -442,7 +449,7 @@ begin end; /////////////////////////////// - Result := 9999; + Result := 0; // Assigns validation numbers to specific damages. validationToDamageAssignments := TValidationToDamageAssignments.Create(FValidation, FValidationLengths, ADamages, @@ -457,7 +464,7 @@ begin for i := 0 to ADamages.Count - 1 do Write(indices[i] - AStartIndex, ' '); WriteLn(')'); - CalcCombinationsBlockMultiValidations(Length(ABlock), ADamages, indices, AStartIndex, AStopIndex); + Result := Result + CalcCombinationsBlockMultiValidations(Length(ABlock), ADamages, indices, AStartIndex, AStopIndex); end; validationToDamageAssignments.Free; end; @@ -526,9 +533,10 @@ begin WriteLn(' ', position.ValidationIndex, ' ', position.MinStart, ' ', position.MaxStart); WriteLn(' offsets'); + Result := 0; validationPositionOffsets := TValidationPositionOffsets.Create(FValidation, positions); for offsets in validationPositionOffsets do - CalcCombinationsBlockAssignedValidations(ABlockLength, positions, offsets, AStartIndex, AStopIndex); + Result := Result + CalcCombinationsBlockAssignedValidations(ABlockLength, positions, offsets, AStartIndex, AStopIndex); validationPositionOffsets.Free; positions.Free; @@ -537,44 +545,52 @@ end; function TConditionRecord.CalcCombinationsBlockAssignedValidations(const ABlockLength: Integer; constref APositionInfos: TValidationPositionInfos; constref AOffsets: TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; var - i, space, freedom, count: Integer; + i, space: Integer; begin Write(' '); for i in AOffsets do Write(i, ' '); - Write(' count/space/freedom: '); - // TODO: Number of combinations is binom(count + freedom, freedom). - if AStartIndex < APositionInfos[0].ValidationIndex then - begin - count := APositionInfos[0].ValidationIndex - AStartIndex; - space := AOffsets[0] - 2; - freedom := space - FValidationLengths[AStartIndex, APositionInfos[0].ValidationIndex]; - Write(count, '/', space, '/', freedom, ' '); - end - else - Write('X '); - for i := 0 to APositionInfos.Count - 2 do - if APositionInfos[i].ValidationIndex + 1 < APositionInfos[i + 1].ValidationIndex then - begin - count := APositionInfos[i + 1].ValidationIndex - APositionInfos[i].ValidationIndex - 1; - space := AOffsets[i + 1] - AOffsets[i] - FValidation[APositionInfos[i].ValidationIndex] - 2; - freedom := space - FValidationLengths[APositionInfos[i].ValidationIndex + 1, APositionInfos[i + 1].ValidationIndex]; - Write(count, '/', space, '/', freedom, ' '); - end - else - Write('X '); - if APositionInfos.Last.ValidationIndex < AStopIndex then - begin - count := AStopIndex - APositionInfos.Last.ValidationIndex; - space := ABlockLength - AOffsets[APositionInfos.Count - 1] - FValidation[APositionInfos.Last.ValidationIndex]; - freedom := space - FValidationLengths[APositionInfos.Last.ValidationIndex + 1, AStopIndex + 1]; - Write(count, '/', space, '/', freedom, ' '); - end - else - Write('X '); + Write(' count/space/freedoms: '); + space := AOffsets[0] - 2; + Result := CalcCombinationsWildcardSequence(space, AStartIndex, APositionInfos[0].ValidationIndex); + if Result = 0 then begin + WriteLn(' result: ', Result); + Exit; + end; - WriteLn; + 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); + if Result = 0 then begin + WriteLn(' result: ', Result); + Exit; + end; + end; + space := ABlockLength - AOffsets[APositionInfos.Count - 1] - FValidation[APositionInfos.Last.ValidationIndex]; + Result := Result * CalcCombinationsWildcardSequence(space, APositionInfos.Last.ValidationIndex + 1, AStopIndex + 1); + WriteLn(' result: ', Result); +end; + +function TConditionRecord.CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer): + Int64; +var + count, freedoms: Integer; +begin + if AStartIndex < AStopIndex then + begin + count := AStopIndex - AStartIndex; + freedoms := ASequenceLength - FValidationLengths[AStartIndex, AStopIndex]; + Write(count, '/', ASequenceLength, '/', freedoms, ' '); + if freedoms >= 0 then + Result := FBinomialCoefficients.Get(count + freedoms, freedoms) + else + Result := 0; + end + else begin + Result := 1; + Write('X '); + end; end; function TConditionRecord.ParseDamages(const ABlock: string): TDamages; @@ -607,8 +623,10 @@ begin end; end; -constructor TConditionRecord.Create; +constructor TConditionRecord.Create(constref ABinomialCoefficients: TBinomialCoefficientCache); begin + FBinomialCoefficients := ABinomialCoefficients; + FBlocks := TStringList.Create; FValidation := TIntegerList.Create; FDamagesBlocks := TDamagesBlocks.Create; @@ -700,6 +718,17 @@ end; { THotSprings } +constructor THotSprings.Create; +begin + FBinomialCoefficients := TBinomialCoefficientCache.Create; +end; + +destructor THotSprings.Destroy; +begin + FBinomialCoefficients.Free; + inherited Destroy; +end; + procedure THotSprings.ProcessDataLine(const ALine: string); var conditionRecord1, conditionRecord2: TConditionRecord; @@ -710,8 +739,8 @@ begin WriteLn(ALine); WriteLn; - conditionRecord1 := TConditionRecord.Create; - conditionRecord2 := TConditionRecord.Create; + conditionRecord1 := TConditionRecord.Create(FBinomialCoefficients); + conditionRecord2 := TConditionRecord.Create(FBinomialCoefficients); mainSplit := ALine.Split([' ']); 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 08/14] 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; From 05863842df74705a5186bb99d452fb19586bcf61 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Fri, 15 Nov 2024 19:08:33 +0100 Subject: [PATCH 09/14] Added TBlock to replace the block strings for day 12 --- solvers/UHotSprings.pas | 211 ++++++++++++++++++++++------------------ 1 file changed, 114 insertions(+), 97 deletions(-) diff --git a/solvers/UHotSprings.pas b/solvers/UHotSprings.pas index 8dbfd56..c82c383 100644 --- a/solvers/UHotSprings.pas +++ b/solvers/UHotSprings.pas @@ -43,10 +43,25 @@ type TDamage = record Start, Length, CharsRemaining: Integer; end; - TDamages = specialize TList; - // TODO: Instead of using TDamagesBlocks, "block" should be a record of a string and its associated list TDamages. - TDamagesBlocks = specialize TObjectList; + + { TBlock } + + TBlock = class + private + FPattern: string; + FDamages: TDamages; + procedure ParseDamages; + public + constructor Create(const APattern: string); + 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; + end; + TBlocks = specialize TObjectList; { TValidationToDamageAssignments } @@ -99,7 +114,7 @@ type FBinomialCoefficients: TBinomialCoefficientCache; FValidation: TIntegerList; // List of non-empty, maximum-length parts of the pattern without operational springs ("blocks"). - FBlocks: TStringList; + FBlocks: TBlocks; // Array 'a' of accumulated validation series lengths. 'a[i, j]' denotes the combined length of consecutive // validation numbers from 'FValidation[i]' to 'FValidation[j - 1]' with a single space in between each pair of // them. @@ -107,32 +122,25 @@ 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: TIntegerArray; - // List 'a' of lists of damages in a block. Each list of damages 'a[i]' contains exactly one entry for each block of - // consecutive damages characters in the i-th block. - // For example, if the pattern is '?#.??##?#?..??', then 'FDamagesBlocks' would have 3 entries, which are lists of - // 1, 2, and 0 damages, respectively. - FDamagesBlocks: TDamagesBlocks; procedure InitValidationLengths; procedure InitMinIndices; function CalcCombinations(constref AIndices: TIntegerArray): Int64; - function CalcCombinationsBlock(const ABlock: string; constref ADamages: TDamages; const AStartIndex, AStopIndex: - Integer): Int64; - function CalcCombinationsBlockSingleValidation(const ABlockLength: Integer; constref ADamages: TDamages; - const AIndex: Integer): Int64; - function CalcCombinationsBlockMultiValidations(const ABlockLength: Integer; constref ADamages: TDamages; - constref AIndices: TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; + function CalcCombinationsBlock(constref ABlock: TBlock; const AStartIndex, AStopIndex: Integer): Int64; + function CalcCombinationsBlockSingleValidation(constref ABlock: TBlock; const AIndex: Integer): Int64; + function CalcCombinationsBlockMultiValidations(constref ABlock: TBlock; constref AIndices: TIndexArray; + const AStartIndex, AStopIndex: Integer): Int64; function CalcCombinationsBlockAssignedValidations(const ABlockLength: Integer; constref APositionInfos: TValidationPositionInfos; constref AOffsets: TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; function CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer): Int64; - function ParseDamages(const ABlock: string): TDamages; public - property Blocks: TStringList read FBlocks; - property Validation: TIntegerList read FValidation; constructor Create(constref ABinomialCoefficients: TBinomialCoefficientCache); destructor Destroy; override; // Adds all non-empty, maximum-length parts of the pattern without operational springs ("blocks"). procedure AddBlocks(const APattern: string); function GenerateBlockAssignments: Int64; + // TODO: Blocks is not needed? + //property Blocks: TBlocks read FBlocks; + property Validation: TIntegerList read FValidation; end; { THotSprings } @@ -154,6 +162,50 @@ type implementation +{ TBlock } + +procedure TBlock.ParseDamages; +var + i, len: Integer; + damage: TDamage; +begin + FDamages := TDamages.Create; + damage.Length := 0; + len := Length(FPattern); + for i := 1 to len do + // The pattern must only contain damage and wildcard characters here. + if FPattern[i] = CDamagedChar then + begin + if damage.Length = 0 then + damage.Start := i; + Inc(damage.Length); + end + else if damage.Length > 0 then + begin + damage.CharsRemaining := len - damage.Start - damage.Length + 1; + FDamages.Add(damage); + damage.Length := 0; + end; + + if damage.Length > 0 then + begin + damage.CharsRemaining := 0; + FDamages.Add(damage); + end; +end; + +constructor TBlock.Create(const APattern: string); +begin + FPattern := APattern; + ParseDamages; +end; + +destructor TBlock.Destroy; +begin + FDamages.Free; + inherited Destroy; +end; + { TValidationToDamageAssignments } function TValidationToDamageAssignments.CalcValidationSpan(constref ACurrentIndexArray: TIndexArray; @@ -307,14 +359,14 @@ var i, j, patternsLength: Integer; begin SetLength(FMinIndices, FBlocks.Count - 1); - patternsLength := Length(FBlocks[FBlocks.Count - 1]); + patternsLength := Length(FBlocks[FBlocks.Count - 1].Pattern); j := FValidation.Count; for i := FBlocks.Count - 2 downto 0 do begin while (j >= 0) and (FValidationLengths[j, FValidation.Count] <= patternsLength) do Dec(j); FMinIndices[i] := j + 1; - patternsLength := patternsLength + 1 + Length(FBlocks[i]); + patternsLength := patternsLength + 1 + Length(FBlocks[i].Pattern); end; end; @@ -334,17 +386,17 @@ begin i := 0; while (Result > 0) and (i < FBlocks.Count) do begin - if FDamagesBlocks[i].Count > 0 then - r := CalcCombinationsBlock(FBlocks[i], FDamagesBlocks[i], AIndices[i], AIndices[i + 1] - 1) + if FBlocks[i].Damages.Count > 0 then + r := CalcCombinationsBlock(FBlocks[i], AIndices[i], AIndices[i + 1] - 1) else begin {$ifdef debug} - Write(' ', FBlocks[i], ' '); + Write(' ', FBlocks[i].Pattern, ' '); 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); + r := CalcCombinationsWildcardSequence(Length(FBlocks[i].Pattern), AIndices[i], AIndices[i + 1] - 1); {$ifdef debug} WriteLn(' result: ', r); {$endif} @@ -357,15 +409,14 @@ begin end; end; -function TConditionRecord.CalcCombinationsBlock(const ABlock: string; constref ADamages: TDamages; const AStartIndex, - AStopIndex: Integer): Int64; +function TConditionRecord.CalcCombinationsBlock(constref ABlock: TBlock; const AStartIndex, AStopIndex: Integer): Int64; var i, j, k: Integer; indices: TIndexArray; validationToDamageAssignments: TValidationToDamageAssignments; begin {$ifdef debug} - Write(' ', ABlock, ' '); + Write(' ', ABlock.Pattern, ' '); for i := AStartIndex to AStopIndex do Write(FValidation[i], ' '); WriteLn; @@ -374,14 +425,14 @@ begin // No validation number assigned to this block. if AStartIndex > AStopIndex then begin - if ADamages.Count = 0 then + if ABlock.Damages.Count = 0 then Result := 1 else Result := 0; end // One validation number assigned to this block. else if AStartIndex = AStopIndex then - Result := CalcCombinationsBlockSingleValidation(Length(ABlock), ADamages, AStartIndex) + Result := CalcCombinationsBlockSingleValidation(ABlock, AStartIndex) // Multiple validation numbers assigned to this block. else begin {$ifdef debug} @@ -394,17 +445,17 @@ begin Write(FValidationLengths[i, AStopIndex + 1] - FValidation[i], ' '); WriteLn; - for i := 0 to ADamages.Count - 1 do + for i := 0 to ABlock.Damages.Count - 1 do begin - WriteLn(' damage: start ',ADamages[i].Start, ', length ', ADamages[i].Length, ', remain ', ADamages[i].CharsRemaining); + 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] < ADamages[i].Start) + 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] <= ADamages[i].CharsRemaining) + and (FValidationLengths[j, AStopIndex + 1] - FValidation[j] <= ABlock.Damages[i].CharsRemaining) // Damage itself small enough for this validation number? - and (FValidation[j] >= ADamages[i].Length) then + and (FValidation[j] >= ABlock.Damages[i].Length) then Write(j - AStartIndex, ' '); WriteLn; end; @@ -413,7 +464,7 @@ begin Result := 0; // Assigns validation numbers to specific damages. - validationToDamageAssignments := TValidationToDamageAssignments.Create(FValidation, FValidationLengths, ADamages, + validationToDamageAssignments := TValidationToDamageAssignments.Create(FValidation, FValidationLengths, ABlock.Damages, AStartIndex, AStopIndex); {$ifdef debug} WriteLn(' validation numbers (indices) per damages:'); @@ -422,44 +473,44 @@ begin begin {$ifdef debug} Write(' '); - for i := 0 to ADamages.Count - 1 do + for i := 0 to ABlock.Damages.Count - 1 do Write(FValidation[indices[i]], ' '); Write('( '); - for i := 0 to ADamages.Count - 1 do + for i := 0 to ABlock.Damages.Count - 1 do Write(indices[i] - AStartIndex, ' '); WriteLn(')'); {$endif} - Result := Result + CalcCombinationsBlockMultiValidations(Length(ABlock), ADamages, indices, AStartIndex, AStopIndex); + Result := Result + CalcCombinationsBlockMultiValidations(ABlock, indices, AStartIndex, AStopIndex); end; validationToDamageAssignments.Free; end; end; -function TConditionRecord.CalcCombinationsBlockSingleValidation(const ABlockLength: Integer; constref ADamages: - TDamages; const AIndex: Integer): Int64; +function TConditionRecord.CalcCombinationsBlockSingleValidation(constref ABlock: TBlock; const AIndex: Integer): Int64; var - combinedDamagesLength: Integer; + len, combinedDamagesLength: Integer; begin - if ABlockLength < FValidation[AIndex] then + len := Length(ABlock.Pattern); + if len < FValidation[AIndex] then Result := 0 - else if ADamages.Count = 0 then - Result := ABlockLength - FValidation[AIndex] + 1 + else if ABlock.Damages.Count = 0 then + Result := len - FValidation[AIndex] + 1 else begin - combinedDamagesLength := ADamages.Last.Start + ADamages.Last.Length - ADamages.First.Start; + combinedDamagesLength := ABlock.Damages.Last.Start + ABlock.Damages.Last.Length - ABlock.Damages.First.Start; if FValidation[AIndex] < combinedDamagesLength then Result := 0 else begin Result := Min(Min(Min( - ADamages.First.Start, + ABlock.Damages.First.Start, FValidation[AIndex] - combinedDamagesLength + 1), - ABlockLength - FValidation[AIndex] + 1), - ADamages.Last.CharsRemaining + 1); + len - FValidation[AIndex] + 1), + ABlock.Damages.Last.CharsRemaining + 1); end; end; end; -function TConditionRecord.CalcCombinationsBlockMultiValidations(const ABlockLength: Integer; constref ADamages: - TDamages; constref AIndices: TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; +function TConditionRecord.CalcCombinationsBlockMultiValidations(constref ABlock: TBlock; constref AIndices: + TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; var i, high: Integer; position: TValidationPositionInfo; @@ -471,25 +522,25 @@ begin high := Length(AIndices) - 1; // Initializes first info record. position.ValidationIndex := AIndices[0]; - position.MaxStart := ADamages[0].Start; + position.MaxStart := ABlock.Damages[0].Start; position.MinStart := 1; for i := 1 to high do if AIndices[i] <> position.ValidationIndex then begin // Finalizes current info record. - position.MaxStart := Min(position.MaxStart, ADamages[i].Start - 1 - FValidation[position.ValidationIndex]); + position.MaxStart := Min(position.MaxStart, ABlock.Damages[i].Start - 1 - FValidation[position.ValidationIndex]); position.MinStart := Max(position.MinStart, - ADamages[i - 1].Start + ADamages[i - 1].Length - FValidation[position.ValidationIndex]); + ABlock.Damages[i - 1].Start + ABlock.Damages[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 + FValidationLengths[AIndices[i - 1], AIndices[i]] + 1; //FValidation[position.ValidationIndex - 1] + 1; + position.MaxStart := ABlock.Damages[i].Start; + position.MinStart := position.MinStart + FValidationLengths[AIndices[i - 1], AIndices[i]] + 1; end; // Finalizes last info record. - position.MaxStart := Min(position.MaxStart, ABlockLength + 1 - FValidation[position.ValidationIndex]); + position.MaxStart := Min(position.MaxStart, Length(ABlock.Pattern) + 1 - FValidation[position.ValidationIndex]); position.MinStart := Max(position.MinStart, - ADamages[high].Start + ADamages[high].Length - FValidation[position.ValidationIndex]); + ABlock.Damages[high].Start + ABlock.Damages[high].Length - FValidation[position.ValidationIndex]); positions.Add(position); {$ifdef debug} @@ -502,7 +553,8 @@ begin Result := 0; validationPositionOffsets := TValidationPositionOffsets.Create(FValidation, positions); for offsets in validationPositionOffsets do - Result := Result + CalcCombinationsBlockAssignedValidations(ABlockLength, positions, offsets, AStartIndex, AStopIndex); + Result := Result + + CalcCombinationsBlockAssignedValidations(Length(ABlock.Pattern), positions, offsets, AStartIndex, AStopIndex); validationPositionOffsets.Free; positions.Free; @@ -571,50 +623,18 @@ begin end; end; -function TConditionRecord.ParseDamages(const ABlock: string): TDamages; -var - i, len: Integer; - damage: TDamage; -begin - Result := TDamages.Create; - damage.Length := 0; - len := Length(ABlock); - for i := 1 to len do - // The pattern must only contain damage and wildcard characters here. - if ABlock[i] = CDamagedChar then - begin - if damage.Length = 0 then - damage.Start := i; - Inc(damage.Length); - end - else if damage.Length > 0 then - begin - damage.CharsRemaining := len - damage.Start - damage.Length + 1; - Result.Add(damage); - damage.Length := 0; - end; - - if damage.Length > 0 then - begin - damage.CharsRemaining := 0; - Result.Add(damage); - end; -end; - constructor TConditionRecord.Create(constref ABinomialCoefficients: TBinomialCoefficientCache); begin FBinomialCoefficients := ABinomialCoefficients; - FBlocks := TStringList.Create; + FBlocks := TBlocks.Create; FValidation := TIntegerList.Create; - FDamagesBlocks := TDamagesBlocks.Create; end; destructor TConditionRecord.Destroy; begin FBlocks.Free; FValidation.Free; - FDamagesBlocks.Free; inherited Destroy; end; @@ -626,10 +646,7 @@ begin split := APattern.Split([COperationalChar]); for part in split do if Length(part) > 0 then - begin - FBlocks.Add(part); - FDamagesBlocks.Add(ParseDamages(part)); - end; + FBlocks.Add(TBlock.Create(part)); end; function TConditionRecord.GenerateBlockAssignments: Int64; @@ -668,7 +685,7 @@ begin while i <= high do begin 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].Pattern) do begin Dec(i); Inc(indices[i]); @@ -686,7 +703,7 @@ begin k := high; while (k > 0) and ((indices[k] = FValidation.Count) - or (FValidationLengths[indices[k - 1], indices[k] + 1] > Length(FBlocks[k - 1]))) do + or (FValidationLengths[indices[k - 1], indices[k] + 1] > Length(FBlocks[k - 1].Pattern))) do Dec(k); Inc(indices[k]); until k = 0; From 3f7fb4a548d1a552f51e14a26091ffedfff3b34d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sun, 17 Nov 2024 17:47:43 +0100 Subject: [PATCH 10/14] Added global BinomialCoefficients instance --- UBinomialCoefficients.pas | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/UBinomialCoefficients.pas b/UBinomialCoefficients.pas index 96b9ff6..71c4780 100644 --- a/UBinomialCoefficients.pas +++ b/UBinomialCoefficients.pas @@ -44,6 +44,9 @@ type function GetCachedRowsCount: Cardinal; end; +var + BinomialCoefficients: TBinomialCoefficientCache; + implementation { TBinomialCoefficientCache } @@ -92,5 +95,11 @@ begin Result := FCache.Count; end; +initialization + BinomialCoefficients := TBinomialCoefficientCache.Create; + +finalization + BinomialCoefficients.Free; + end. From ec6928679ab1f42612bb524d08e6663b2747e794 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sun, 17 Nov 2024 23:54:08 +0100 Subject: [PATCH 11/14] Updated day 12 WIP performance refactor - Added combinations calculation directly to the multi-index enumerable (TValidationPositionOffsets) and added new intermediate derived class TAccumulatedCombinationsMultiIndexStrategy to make this reusable for the other enumerables - Removed TBinomialCoefficientCache instances and used new global instance instead - Renamed TValidationToDamageAssignments to TDamageToValidationAssignments --- UCommon.pas | 1 + solvers/UHotSprings.pas | 230 +++++++++++++++++++++++----------------- 2 files changed, 131 insertions(+), 100 deletions(-) diff --git a/UCommon.pas b/UCommon.pas index 00961f0..4380962 100644 --- a/UCommon.pas +++ b/UCommon.pas @@ -41,6 +41,7 @@ const type TIntegerList = specialize TList; + TInt64Array = array of Int64; implementation diff --git a/solvers/UHotSprings.pas b/solvers/UHotSprings.pas index c82c383..a7b47b6 100644 --- a/solvers/UHotSprings.pas +++ b/solvers/UHotSprings.pas @@ -63,9 +63,9 @@ type end; TBlocks = specialize TObjectList; - { TValidationToDamageAssignments } + { TDamageToValidationAssignments } - TValidationToDamageAssignments = class(TEnumerableMultiIndexStrategy) + TDamageToValidationAssignments = class(TEnumerableMultiIndexStrategy) private FValidation: TIntegerList; FValidationLengths: TValidationLengths; @@ -92,14 +92,34 @@ type TValidationPositionInfos = specialize TList; + TConditionRecord = class; + + { TAccumulatedCombinationsMultiIndexStrategy } + + TAccumulatedCombinationsMultiIndexStrategy = class(TEnumerableMultiIndexStrategy) + private + FAccumulatedCombinations: TInt64Array; + protected + function CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): Int64; virtual; + abstract; + function UpdateCombinations(const AValidationResult: TIndexValidationResult; constref ACurrentIndexArray: + TIndexArray; const ACurrentIndex: Integer): TIndexValidationResult; + public + function GetCombinations: Int64; + end; + { TValidationPositionOffsets } - TValidationPositionOffsets = class(TEnumerableMultiIndexStrategy) + TValidationPositionOffsets = class(TAccumulatedCombinationsMultiIndexStrategy) private - FValidation: TIntegerList; + FConditionRecord: TConditionRecord; FPositionInfos: TValidationPositionInfos; + FBlockLength, FStartIndex, FStopIndex: Integer; + protected + function CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): Int64; override; public - constructor Create(constref AValidation: TIntegerList; constref APositionInfos: TValidationPositionInfos); + constructor Create(constref AConditionRecord: TConditionRecord; constref APositionInfos: TValidationPositionInfos; + const ABlockLength, AStartIndex, AStopIndex: Integer); function GetCardinality: Integer; override; function TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer; out AStartIndexValue: Integer): Boolean; override; @@ -111,7 +131,6 @@ type TConditionRecord = class private - FBinomialCoefficients: TBinomialCoefficientCache; FValidation: TIntegerList; // List of non-empty, maximum-length parts of the pattern without operational springs ("blocks"). FBlocks: TBlocks; @@ -129,17 +148,13 @@ type function CalcCombinationsBlockSingleValidation(constref ABlock: TBlock; const AIndex: Integer): Int64; function CalcCombinationsBlockMultiValidations(constref ABlock: TBlock; constref AIndices: TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; - function CalcCombinationsBlockAssignedValidations(const ABlockLength: Integer; constref APositionInfos: - TValidationPositionInfos; constref AOffsets: TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; - function CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer): Int64; public - constructor Create(constref ABinomialCoefficients: TBinomialCoefficientCache); + constructor Create; destructor Destroy; override; // Adds all non-empty, maximum-length parts of the pattern without operational springs ("blocks"). procedure AddBlocks(const APattern: string); function GenerateBlockAssignments: Int64; - // TODO: Blocks is not needed? - //property Blocks: TBlocks read FBlocks; + function CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer): Int64; property Validation: TIntegerList read FValidation; end; @@ -147,8 +162,6 @@ type THotSprings = class(TSolver) private - // Keeping the binomial coefficients calculator here so it can be shared for all lines. - FBinomialCoefficients: TBinomialCoefficientCache; // TODO: Remove FDebugIndex. FDebugIndex: Integer; public @@ -206,9 +219,9 @@ begin inherited Destroy; end; -{ TValidationToDamageAssignments } +{ TDamageToValidationAssignments } -function TValidationToDamageAssignments.CalcValidationSpan(constref ACurrentIndexArray: TIndexArray; +function TDamageToValidationAssignments.CalcValidationSpan(constref ACurrentIndexArray: TIndexArray; const ALastDamageIndex, AValidationNumber: Integer): Integer; var spanStart: Integer; @@ -221,7 +234,7 @@ begin Inc(Result, FDamages[ALastDamageIndex].Start - FDamages[spanStart].Start); end; -constructor TValidationToDamageAssignments.Create(constref AValidation: TIntegerList; constref AValidationLengths: +constructor TDamageToValidationAssignments.Create(constref AValidation: TIntegerList; constref AValidationLengths: TValidationLengths; constref ADamages: TDamages; const AStartIndex, AStopIndex: Integer); begin FValidation := AValidation; @@ -231,12 +244,12 @@ begin FValidationStopIndex := AStopIndex; end; -function TValidationToDamageAssignments.GetCardinality: Integer; +function TDamageToValidationAssignments.GetCardinality: Integer; begin Result := FDamages.Count; end; -function TValidationToDamageAssignments.TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; +function TDamageToValidationAssignments.TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer; out AStartIndexValue: Integer): Boolean; begin Result := True; @@ -246,7 +259,7 @@ begin AStartIndexValue := FValidationStartIndex; end; -function TValidationToDamageAssignments.ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; +function TDamageToValidationAssignments.ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): TIndexValidationResult; var i, prev, firstSkip: Integer; @@ -296,13 +309,71 @@ begin Result := ivrValid; end; +{ TAccumulatedCombinationsMultiIndexStrategy } + +function TAccumulatedCombinationsMultiIndexStrategy.UpdateCombinations(const AValidationResult: TIndexValidationResult; + constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): TIndexValidationResult; +var + combinations: Int64; +begin + Result := AValidationResult; + if Result = ivrValid then + begin + combinations := CalcCombinations(ACurrentIndexArray, ACurrentIndex); + if combinations = 0 then + Result := ivrBacktrack + else if ACurrentIndex > 0 then + FAccumulatedCombinations[ACurrentIndex] := combinations * FAccumulatedCombinations[ACurrentIndex - 1] + else begin + SetLength(FAccumulatedCombinations, GetCardinality); + FAccumulatedCombinations[ACurrentIndex] := combinations; + end; + end; +end; + +function TAccumulatedCombinationsMultiIndexStrategy.GetCombinations: Int64; +begin + Result := FAccumulatedCombinations[GetCardinality - 1]; +end; + { TValidationPositionOffsets } -constructor TValidationPositionOffsets.Create(constref AValidation: TIntegerList; constref APositionInfos: - TValidationPositionInfos); +function TValidationPositionOffsets.CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: + Integer): Int64; +var + space, start, stop: Integer; begin - FValidation := AValidation; + stop := FPositionInfos[ACurrentIndex].ValidationIndex - 1; + if ACurrentIndex > 0 then + begin + space := ACurrentIndexArray[ACurrentIndex] - ACurrentIndexArray[ACurrentIndex - 1] + - FConditionRecord.Validation[FPositionInfos[ACurrentIndex - 1].ValidationIndex] - 2; + start := FPositionInfos[ACurrentIndex - 1].ValidationIndex + 1; + Result := FConditionRecord.CalcCombinationsWildcardSequence(space, start, stop); + end + else begin + // Handles first calculated offset. + space := ACurrentIndexArray[0] - 2; + Result := FConditionRecord.CalcCombinationsWildcardSequence(space, FStartIndex, stop); + end; + + if (Result > 0) and (ACurrentIndex + 1 = GetCardinality) then + begin + // Handles last calculated offset. + space := FBlockLength - ACurrentIndexArray[ACurrentIndex] - FConditionRecord.Validation[FPositionInfos.Last.ValidationIndex]; + Result := Result * FConditionRecord.CalcCombinationsWildcardSequence(space, FPositionInfos.Last.ValidationIndex + 1, FStopIndex); + end; +end; + +constructor TValidationPositionOffsets.Create(constref AConditionRecord: TConditionRecord; constref APositionInfos: + TValidationPositionInfos; const ABlockLength, AStartIndex, AStopIndex: Integer); +begin + FConditionRecord := AConditionRecord; FPositionInfos := APositionInfos; + FBlockLength := ABlockLength; + FStartIndex := AStartIndex; + FStopIndex := AStopIndex; + inherited Create; end; function TValidationPositionOffsets.GetCardinality: Integer; @@ -317,13 +388,12 @@ var begin info := FPositionInfos[ACurrentIndex]; // Calculates start value such that the validation number just includes MinEnd. - //AStartIndexValue := info.MinEnd - FValidation[info.ValidationIndex] + 1; AStartIndexValue := info.MinStart; // Adjusts start value to avoid overlap of this validation number with the previous one (the one from previous // position info). if ACurrentIndex > 0 then AStartIndexValue := Max(AStartIndexValue, - ACurrentIndexArray[ACurrentIndex - 1] + FValidation[FPositionInfos[ACurrentIndex - 1].ValidationIndex] + 1); + ACurrentIndexArray[ACurrentIndex - 1] + FConditionRecord.Validation[FPositionInfos[ACurrentIndex - 1].ValidationIndex] + 1); Result := True; end; @@ -334,6 +404,8 @@ begin Result := ivrValid else Result := ivrBacktrack; + + Result := UpdateCombinations(Result, ACurrentIndexArray, ACurrentIndex); end; { TConditionRecord } @@ -413,7 +485,7 @@ function TConditionRecord.CalcCombinationsBlock(constref ABlock: TBlock; const A var i, j, k: Integer; indices: TIndexArray; - validationToDamageAssignments: TValidationToDamageAssignments; + validationToDamageAssignments: TDamageToValidationAssignments; begin {$ifdef debug} Write(' ', ABlock.Pattern, ' '); @@ -464,7 +536,7 @@ begin Result := 0; // Assigns validation numbers to specific damages. - validationToDamageAssignments := TValidationToDamageAssignments.Create(FValidation, FValidationLengths, ABlock.Damages, + validationToDamageAssignments := TDamageToValidationAssignments.Create(FValidation, FValidationLengths, ABlock.Damages, AStartIndex, AStopIndex); {$ifdef debug} WriteLn(' validation numbers (indices) per damages:'); @@ -551,82 +623,17 @@ begin WriteLn(' offsets'); {$endif} Result := 0; - validationPositionOffsets := TValidationPositionOffsets.Create(FValidation, positions); + validationPositionOffsets := TValidationPositionOffsets.Create(Self, positions, Length(ABlock.Pattern), + AStartIndex, AStopIndex); for offsets in validationPositionOffsets do - Result := Result - + CalcCombinationsBlockAssignedValidations(Length(ABlock.Pattern), positions, offsets, AStartIndex, AStopIndex); + Result := Result + validationPositionOffsets.GetCombinations; validationPositionOffsets.Free; positions.Free; end; -function TConditionRecord.CalcCombinationsBlockAssignedValidations(const ABlockLength: Integer; constref APositionInfos: - TValidationPositionInfos; constref AOffsets: TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; -var - i, space: Integer; +constructor TConditionRecord.Create; 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 - 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 - 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); - {$ifdef debug} - WriteLn(' result: ', Result); - {$endif} -end; - -function TConditionRecord.CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer): - Int64; -var - count, freedoms: Integer; -begin - if AStartIndex < AStopIndex + 1 then - begin - 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 - Result := 0; - end - else begin - Result := 1; - {$ifdef debug} - Write('X '); - {$endif} - end; -end; - -constructor TConditionRecord.Create(constref ABinomialCoefficients: TBinomialCoefficientCache); -begin - FBinomialCoefficients := ABinomialCoefficients; - FBlocks := TBlocks.Create; FValidation := TIntegerList.Create; end; @@ -710,17 +717,40 @@ begin WriteLn(' missed: ', misses, '/', count); end; +function TConditionRecord.CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer): + Int64; +var + count, freedoms: Integer; +begin + if AStartIndex < AStopIndex + 1 then + 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 + Result := 1; + {$ifdef debug} + Write('X '); + {$endif} + end; +end; + { THotSprings } constructor THotSprings.Create; begin FDebugIndex := 0; - FBinomialCoefficients := TBinomialCoefficientCache.Create; end; destructor THotSprings.Destroy; begin - FBinomialCoefficients.Free; inherited Destroy; end; @@ -736,8 +766,8 @@ begin WriteLn; {$endif} - conditionRecord1 := TConditionRecord.Create(FBinomialCoefficients); - conditionRecord2 := TConditionRecord.Create(FBinomialCoefficients); + conditionRecord1 := TConditionRecord.Create; + conditionRecord2 := TConditionRecord.Create; mainSplit := ALine.Split([' ']); From 16e7528b347335efd77542408aaf35d679cc6b5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Tue, 19 Nov 2024 18:14:14 +0100 Subject: [PATCH 12/14] Updated day 12 WIP performance refactor - Added TValidationsToBlockAssignments to replace the loops in TConditionRecord.GenerateBlockAssignments --- UMultiIndexEnumerator.pas | 1 + solvers/UHotSprings.pas | 538 +++++++++++++++++++------------------- 2 files changed, 265 insertions(+), 274 deletions(-) diff --git a/UMultiIndexEnumerator.pas b/UMultiIndexEnumerator.pas index ca02c55..67dc020 100644 --- a/UMultiIndexEnumerator.pas +++ b/UMultiIndexEnumerator.pas @@ -52,6 +52,7 @@ type TEnumerableMultiIndexStrategy = class(TInterfacedObject, specialize IEnumerable) public function GetEnumerator: specialize IEnumerator; + // Returns the number of indices to iterate over, must return positive (non-zero) value. function GetCardinality: Integer; virtual; abstract; function TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer; out AStartIndexValue: Integer): Boolean; virtual; abstract; diff --git a/solvers/UHotSprings.pas b/solvers/UHotSprings.pas index a7b47b6..5035ec0 100644 --- a/solvers/UHotSprings.pas +++ b/solvers/UHotSprings.pas @@ -35,8 +35,6 @@ const type TValidationLengths = array of array of Integer; - // TODO: TIntegerArray probably not needed. - TIntegerArray = array of Integer; { TDamage } @@ -63,20 +61,57 @@ type end; TBlocks = specialize TObjectList; + { TAccumulatedCombinationsMultiIndexStrategy } + + // Adds accumulated combinations to the enumerable strategy to allow calculation of combinations on the fly, and + // therefore early rejection of invalid multi-index configurations. + TAccumulatedCombinationsMultiIndexStrategy = class(TEnumerableMultiIndexStrategy) + private + FAccumulatedCombinations: TInt64Array; + protected + function CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): Int64; virtual; + abstract; + function UpdateCombinations(const AValidationResult: TIndexValidationResult; constref ACurrentIndexArray: + TIndexArray; const ACurrentIndex: Integer): TIndexValidationResult; + public + function GetCombinations: Int64; + end; + + TConditionRecord = class; + + { TValidationsToBlockAssignments } + + // Enumerable strategy that enumerates all valid assignments of ranges of validation numbers to individual blocks in + // the form of start and stop indices. + TValidationsToBlockAssignments = class(TAccumulatedCombinationsMultiIndexStrategy) + private + FConditionRecord: TConditionRecord; + protected + function CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): Int64; override; + public + constructor Create(constref AConditionRecord: TConditionRecord); + function GetCardinality: Integer; override; + function TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer; + out AStartIndexValue: Integer): Boolean; override; + function ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): + TIndexValidationResult; override; + end; + { TDamageToValidationAssignments } + // Enumerable strategy that enumerates all valid assignments of each damage in the block to a specific validation + // number from the validation numbers that have been assigned to the block, as indicated by start and stop indices. TDamageToValidationAssignments = class(TEnumerableMultiIndexStrategy) private - FValidation: TIntegerList; - FValidationLengths: TValidationLengths; - FDamages: TDamages; + FConditionRecord: TConditionRecord; + FBlock: TBlock; FValidationStartIndex, FValidationStopIndex: Integer; - // Calculates "span", the length of all damages for this validation number combined. + // Calculates "span", the length of all damages for one validation number combined. function CalcValidationSpan(constref ACurrentIndexArray: TIndexArray; const ALastDamageIndex, AValidationNumber: Integer): Integer; public - constructor Create(constref AValidation: TIntegerList; constref AValidationLengths: TValidationLengths; - constref ADamages: TDamages; const AStartIndex, AStopIndex: Integer); + constructor Create(constref AConditionRecord: TConditionRecord; constref ABlock: TBlock; + const AStartValidationIndex, AStopValidationIndex: Integer); function GetCardinality: Integer; override; function TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer; out AStartIndexValue: Integer): Boolean; override; @@ -92,34 +127,21 @@ type TValidationPositionInfos = specialize TList; - TConditionRecord = class; - - { TAccumulatedCombinationsMultiIndexStrategy } - - TAccumulatedCombinationsMultiIndexStrategy = class(TEnumerableMultiIndexStrategy) - private - FAccumulatedCombinations: TInt64Array; - protected - function CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): Int64; virtual; - abstract; - function UpdateCombinations(const AValidationResult: TIndexValidationResult; constref ACurrentIndexArray: - TIndexArray; const ACurrentIndex: Integer): TIndexValidationResult; - public - function GetCombinations: Int64; - end; - { TValidationPositionOffsets } + // Enumerable strategy that enumerates all valid assignments of start positions (positions mean character indices in + // the block patterns) of validation numbers that have been assigned to damages in the current block, as indicated by + // provided TValidationPositionInfos. TValidationPositionOffsets = class(TAccumulatedCombinationsMultiIndexStrategy) private FConditionRecord: TConditionRecord; FPositionInfos: TValidationPositionInfos; - FBlockLength, FStartIndex, FStopIndex: Integer; + FBlockLength, FValidationStartIndex, FValidationStopIndex: Integer; protected function CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): Int64; override; public constructor Create(constref AConditionRecord: TConditionRecord; constref APositionInfos: TValidationPositionInfos; - const ABlockLength, AStartIndex, AStopIndex: Integer); + const ABlockLength, AValidationStartIndex, AValidationStopIndex: Integer); function GetCardinality: Integer; override; function TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer; out AStartIndexValue: Integer): Boolean; override; @@ -131,6 +153,7 @@ type TConditionRecord = class private + // List of validation numbers as stated in the problem input. FValidation: TIntegerList; // List of non-empty, maximum-length parts of the pattern without operational springs ("blocks"). FBlocks: TBlocks; @@ -140,11 +163,9 @@ type FValidationLengths: TValidationLengths; // 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; + FMinIndices: TIndexArray; procedure InitValidationLengths; procedure InitMinIndices; - function CalcCombinations(constref AIndices: TIntegerArray): Int64; - function CalcCombinationsBlock(constref ABlock: TBlock; const AStartIndex, AStopIndex: Integer): Int64; function CalcCombinationsBlockSingleValidation(constref ABlock: TBlock; const AIndex: Integer): Int64; function CalcCombinationsBlockMultiValidations(constref ABlock: TBlock; constref AIndices: TIndexArray; const AStartIndex, AStopIndex: Integer): Int64; @@ -154,8 +175,12 @@ type // Adds all non-empty, maximum-length parts of the pattern without operational springs ("blocks"). procedure AddBlocks(const APattern: string); function GenerateBlockAssignments: Int64; + function CalcCombinationsBlock(constref ABlock: TBlock; const AStartIndex, AStopIndex: Integer): Int64; function CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer): Int64; property Validation: TIntegerList read FValidation; + property Blocks: TBlocks read FBlocks; + property ValidationLengths: TValidationLengths read FValidationLengths; + property MinIndices: TIndexArray read FMinIndices; end; { THotSprings } @@ -219,6 +244,104 @@ begin inherited Destroy; end; +{ TAccumulatedCombinationsMultiIndexStrategy } + +function TAccumulatedCombinationsMultiIndexStrategy.UpdateCombinations(const AValidationResult: TIndexValidationResult; + constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): TIndexValidationResult; +var + combinations: Int64; +begin + Result := AValidationResult; + if Result = ivrValid then + begin + combinations := CalcCombinations(ACurrentIndexArray, ACurrentIndex); + if combinations = 0 then + Result := ivrSkip + else if ACurrentIndex > 0 then + FAccumulatedCombinations[ACurrentIndex] := combinations * FAccumulatedCombinations[ACurrentIndex - 1] + else begin + SetLength(FAccumulatedCombinations, GetCardinality); + FAccumulatedCombinations[ACurrentIndex] := combinations; + end; + end; +end; + +function TAccumulatedCombinationsMultiIndexStrategy.GetCombinations: Int64; +begin + if FAccumulatedCombinations <> nil then + Result := FAccumulatedCombinations[GetCardinality - 1] + else + Result := 0; +end; + +{ TValidationsToBlockAssignments } + +function TValidationsToBlockAssignments.CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: + Integer): Int64; +var + block: TBlock; + start, stop: Integer; +begin + // 'ACurrentIndexArray[i] - 1' denotes the index of the last validation number assigned to 'Block[i]', and the index + // of the first validation number in 'Validation' assigned to 'Block[i + 1]'. If two consecutive values in + // 'ACurrentIndexArray' are the same, then the block in between has no numbers assigned to it. + block := FConditionRecord.Blocks[ACurrentIndex]; + if ACurrentIndex > 0 then + start := ACurrentIndexArray[ACurrentIndex - 1] + else + start := 0; + stop := ACurrentIndexArray[ACurrentIndex] - 1; + if block.Damages.Count > 0 then + Result := FConditionRecord.CalcCombinationsBlock(block, start, stop) + else + Result := FConditionRecord.CalcCombinationsWildcardSequence(Length(block.Pattern), start, stop); +end; + +constructor TValidationsToBlockAssignments.Create(constref AConditionRecord: TConditionRecord); +begin + FConditionRecord := AConditionRecord; +end; + +function TValidationsToBlockAssignments.GetCardinality: Integer; +begin + Result := FConditionRecord.Blocks.Count; +end; + +function TValidationsToBlockAssignments.TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; + const ACurrentIndex: Integer; out AStartIndexValue: Integer): Boolean; +begin + Result := True; + if ACurrentIndex + 1 = GetCardinality then + AStartIndexValue := FConditionRecord.Validation.Count + else if ACurrentIndex > 0 then + AStartIndexValue := Max(ACurrentIndexArray[ACurrentIndex - 1], FConditionRecord.MinIndices[ACurrentIndex]) + else + AStartIndexValue := FConditionRecord.MinIndices[ACurrentIndex]; +end; + +function TValidationsToBlockAssignments.ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; + const ACurrentIndex: Integer): TIndexValidationResult; +var + start: Integer; +begin + if ACurrentIndexArray[ACurrentIndex] > FConditionRecord.Validation.Count then + Result := ivrBacktrack + else begin + if ACurrentIndex > 0 then + start := ACurrentIndexArray[ACurrentIndex - 1] + else + start := 0; + + if FConditionRecord.ValidationLengths[start, ACurrentIndexArray[ACurrentIndex]] + <= Length(FConditionRecord.Blocks[ACurrentIndex].Pattern) then + Result := ivrValid + else + Result := ivrBacktrack; + end; + + Result := UpdateCombinations(Result, ACurrentIndexArray, ACurrentIndex); +end; + { TDamageToValidationAssignments } function TDamageToValidationAssignments.CalcValidationSpan(constref ACurrentIndexArray: TIndexArray; @@ -229,24 +352,23 @@ begin spanStart := ALastDamageIndex; while (spanStart > 0) and (ACurrentIndexArray[spanStart - 1] = AValidationNumber) do Dec(spanStart); - Result := FDamages[ALastDamageIndex].Length; + Result := FBlock.Damages[ALastDamageIndex].Length; if spanStart < ALastDamageIndex then - Inc(Result, FDamages[ALastDamageIndex].Start - FDamages[spanStart].Start); + Inc(Result, FBlock.Damages[ALastDamageIndex].Start - FBlock.Damages[spanStart].Start); end; -constructor TDamageToValidationAssignments.Create(constref AValidation: TIntegerList; constref AValidationLengths: - TValidationLengths; constref ADamages: TDamages; const AStartIndex, AStopIndex: Integer); +constructor TDamageToValidationAssignments.Create(constref AConditionRecord: TConditionRecord; constref ABlock: TBlock; + const AStartValidationIndex, AStopValidationIndex: Integer); begin - FValidation := AValidation; - FValidationLengths := AValidationLengths; - FDamages := ADamages; - FValidationStartIndex := AStartIndex; - FValidationStopIndex := AStopIndex; + FConditionRecord := AConditionRecord; + FBlock := ABlock; + FValidationStartIndex := AStartValidationIndex; + FValidationStopIndex := AStopValidationIndex; end; function TDamageToValidationAssignments.GetCardinality: Integer; begin - Result := FDamages.Count; + Result := FBlock.Damages.Count; end; function TDamageToValidationAssignments.TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; @@ -262,78 +384,32 @@ end; function TDamageToValidationAssignments.ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): TIndexValidationResult; var - i, prev, firstSkip: Integer; + i, prev: Integer; begin i := ACurrentIndexArray[ACurrentIndex]; + prev := ACurrentIndex - 1; + // Checks maximum index value. if i > FValidationStopIndex then - begin - Result := ivrBacktrack; - Exit; - end; - + Result := ivrBacktrack // Checks if there is enough space after this damage for remaining validation numbers. - if (i < FValidationStopIndex) - and (FValidationLengths[i + 1, FValidationStopIndex + 1] + 1 > FDamages[ACurrentIndex].CharsRemaining) then - begin - Result := ivrSkip; - Exit; - end; - + else if (i < FValidationStopIndex) + and (FConditionRecord.ValidationLengths[i + 1, FValidationStopIndex + 1] + 1 > FBlock.Damages[ACurrentIndex].CharsRemaining) then + Result := ivrSkip // 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 - begin - Result := ivrBacktrack; - Exit; - end; - + else if (FValidationStartIndex < i) + and (FConditionRecord.ValidationLengths[FValidationStartIndex, i] + 1 >= FBlock.Damages[ACurrentIndex].Start) then + Result := ivrBacktrack // Checks if there is enough space between previous and this damage for skipped validation numbers. - if ACurrentIndex > 0 then - begin - prev := ACurrentIndex - 1; - firstSkip := ACurrentIndexArray[prev] + 1; - if (firstSkip < i) and (FValidationLengths[firstSkip, i] + 2 > FDamages[ACurrentIndex].Start - FDamages[prev].Start - FDamages[prev].Length) then - begin - Result := ivrBacktrack; - Exit; - end; - end; - + else if (ACurrentIndex > 0) + and (ACurrentIndexArray[prev] + 1 < i) + and (FConditionRecord.ValidationLengths[ACurrentIndexArray[prev] + 1, i] + 2 + > FBlock.Damages[ACurrentIndex].Start - FBlock.Damages[prev].Start - FBlock.Damages[prev].Length) then + Result := ivrBacktrack // Checks if span is small enough to fit within this validation number. - if FValidation[i] < CalcValidationSpan(ACurrentIndexArray, ACurrentIndex, i) then - begin - Result := ivrSkip; - Exit; - end; - - Result := ivrValid; -end; - -{ TAccumulatedCombinationsMultiIndexStrategy } - -function TAccumulatedCombinationsMultiIndexStrategy.UpdateCombinations(const AValidationResult: TIndexValidationResult; - constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): TIndexValidationResult; -var - combinations: Int64; -begin - Result := AValidationResult; - if Result = ivrValid then - begin - combinations := CalcCombinations(ACurrentIndexArray, ACurrentIndex); - if combinations = 0 then - Result := ivrBacktrack - else if ACurrentIndex > 0 then - FAccumulatedCombinations[ACurrentIndex] := combinations * FAccumulatedCombinations[ACurrentIndex - 1] - else begin - SetLength(FAccumulatedCombinations, GetCardinality); - FAccumulatedCombinations[ACurrentIndex] := combinations; - end; - end; -end; - -function TAccumulatedCombinationsMultiIndexStrategy.GetCombinations: Int64; -begin - Result := FAccumulatedCombinations[GetCardinality - 1]; + else if FConditionRecord.Validation[i] < CalcValidationSpan(ACurrentIndexArray, ACurrentIndex, i) then + Result := ivrSkip + else + Result := ivrValid; end; { TValidationPositionOffsets } @@ -354,25 +430,26 @@ begin else begin // Handles first calculated offset. space := ACurrentIndexArray[0] - 2; - Result := FConditionRecord.CalcCombinationsWildcardSequence(space, FStartIndex, stop); + Result := FConditionRecord.CalcCombinationsWildcardSequence(space, FValidationStartIndex, stop); end; if (Result > 0) and (ACurrentIndex + 1 = GetCardinality) then begin // Handles last calculated offset. space := FBlockLength - ACurrentIndexArray[ACurrentIndex] - FConditionRecord.Validation[FPositionInfos.Last.ValidationIndex]; - Result := Result * FConditionRecord.CalcCombinationsWildcardSequence(space, FPositionInfos.Last.ValidationIndex + 1, FStopIndex); + start := FPositionInfos.Last.ValidationIndex + 1; + Result := Result * FConditionRecord.CalcCombinationsWildcardSequence(space, start, FValidationStopIndex); end; end; constructor TValidationPositionOffsets.Create(constref AConditionRecord: TConditionRecord; constref APositionInfos: - TValidationPositionInfos; const ABlockLength, AStartIndex, AStopIndex: Integer); + TValidationPositionInfos; const ABlockLength, AValidationStartIndex, AValidationStopIndex: Integer); begin FConditionRecord := AConditionRecord; FPositionInfos := APositionInfos; FBlockLength := ABlockLength; - FStartIndex := AStartIndex; - FStopIndex := AStopIndex; + FValidationStartIndex := AValidationStartIndex; + FValidationStopIndex := AValidationStopIndex; inherited Create; end; @@ -387,7 +464,6 @@ var info: TValidationPositionInfo; begin info := FPositionInfos[ACurrentIndex]; - // Calculates start value such that the validation number just includes MinEnd. AStartIndexValue := info.MinStart; // Adjusts start value to avoid overlap of this validation number with the previous one (the one from previous // position info). @@ -442,122 +518,6 @@ begin end; end; -function TConditionRecord.CalcCombinations(constref AIndices: TIntegerArray): Int64; -var - 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 - if FBlocks[i].Damages.Count > 0 then - r := CalcCombinationsBlock(FBlocks[i], AIndices[i], AIndices[i + 1] - 1) - else begin - {$ifdef debug} - Write(' ', FBlocks[i].Pattern, ' '); - for j := AIndices[i] to AIndices[i + 1] - 1 do - Write(FValidation[j], ' '); - WriteLn; - Write(' count/space/freedoms: '); - {$endif} - r := CalcCombinationsWildcardSequence(Length(FBlocks[i].Pattern), 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; - -function TConditionRecord.CalcCombinationsBlock(constref ABlock: TBlock; const AStartIndex, AStopIndex: Integer): Int64; -var - i, j, k: Integer; - indices: TIndexArray; - validationToDamageAssignments: 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 - if ABlock.Damages.Count = 0 then - Result := 1 - else - Result := 0; - end - // One validation number assigned to this block. - else if AStartIndex = AStopIndex then - Result := CalcCombinationsBlockSingleValidation(ABlock, 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], ' '); - 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 - 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. - validationToDamageAssignments := TDamageToValidationAssignments.Create(FValidation, FValidationLengths, ABlock.Damages, - AStartIndex, AStopIndex); - {$ifdef debug} - WriteLn(' validation numbers (indices) per damages:'); - {$endif} - for indices in validationToDamageAssignments 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; - validationToDamageAssignments.Free; - end; -end; - function TConditionRecord.CalcCombinationsBlockSingleValidation(constref ABlock: TBlock; const AIndex: Integer): Int64; var len, combinedDamagesLength: Integer; @@ -658,63 +618,93 @@ end; function TConditionRecord.GenerateBlockAssignments: Int64; var - indices: array of Integer; - i, j, k, high: Integer; - // TODO: Remove r, count, misses. - r: Int64; - count, misses: Integer; + validationsToBlockAssignments: TValidationsToBlockAssignments; + indices: TIndexArray; 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. - // - // Here, 'indices[i]' denotes the index + 1 of the last validation number assigned to 'FBlockPattern[i]', and the - // index of the first validation number in 'FValidation' assigned to 'FBlockPattern[i + 1]'. If two consecutive values - // in 'indices' are the same, then the block in between has no numbers assigned to it. - // - // Note that 'indices[0] = 0' and 'indices[FBlockPatterns.Count] = FValidation.Count' are constant. Having these two - // numbers in the array simplifies the code a bit. InitValidationLengths; - //FPatternLengths := CalcPatternLengths; InitMinIndices; - SetLength(indices, FBlocks.Count + 1); - high := Length(indices) - 2; - indices[0] := 0; - indices[high + 1] := FValidation.Count; - - // TODO: Use TMultiIndexEnumerator for this. Result := 0; - k := 0; - repeat - i := k + 1; - while i <= high do + validationsToBlockAssignments := TValidationsToBlockAssignments.Create(Self); + for indices in validationsToBlockAssignments do + Result := Result + validationsToBlockAssignments.GetCombinations; + validationsToBlockAssignments.Free; +end; + +function TConditionRecord.CalcCombinationsBlock(constref ABlock: TBlock; const AStartIndex, AStopIndex: Integer): Int64; +var + i, j, k: Integer; + 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 + if ABlock.Damages.Count = 0 then + Result := 1 + else + Result := 0; + end + // One validation number assigned to this block. + else if AStartIndex = AStopIndex then + Result := CalcCombinationsBlockSingleValidation(ABlock, 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], ' '); + 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 begin - indices[i] := Max(indices[i - 1], FMinIndices[i - 1]); - while FValidationLengths[indices[i - 1], indices[i]] > Length(FBlocks[i - 1].Pattern) do - begin - Dec(i); - Inc(indices[i]); - end; - - Inc(i); + 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} - Inc(count); - r := CalcCombinations(indices); - if r = 0 then - Inc(misses); - Result := Result + r; + Result := 0; - k := high; - while (k > 0) - and ((indices[k] = FValidation.Count) - or (FValidationLengths[indices[k - 1], indices[k] + 1] > Length(FBlocks[k - 1].Pattern))) do - Dec(k); - Inc(indices[k]); - until k = 0; - WriteLn(' missed: ', misses, '/', count); + // 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; + end; end; function TConditionRecord.CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer): From 2ff41caf37606efaf94c61482a65afe06e616d3e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Tue, 19 Nov 2024 22:58:15 +0100 Subject: [PATCH 13/14] Added caching of calculated combinations per block for day 12 --- solvers/UHotSprings.pas | 141 ++++++++++++++-------------------------- 1 file changed, 49 insertions(+), 92 deletions(-) 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; From a55cae955ac210041332b224cd362cc7c3f50673 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Tue, 19 Nov 2024 22:58:51 +0100 Subject: [PATCH 14/14] Fixed day 12 tests --- tests/UHotSpringsTestCases.pas | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/tests/UHotSpringsTestCases.pas b/tests/UHotSpringsTestCases.pas index 6819d82..cac94b0 100644 --- a/tests/UHotSpringsTestCases.pas +++ b/tests/UHotSpringsTestCases.pas @@ -26,16 +26,6 @@ uses type - { THotSpringsFullDataTestCase } - - THotSpringsFullDataTestCase = class(TEngineBaseTest) - protected - function CreateSolver: ISolver; override; - published - procedure TestPart1; - procedure TestPart2; - end; - { THotSpringsExampleTestCase } THotSpringsExampleTestCase = class(TExampleEngineBaseTest) @@ -69,11 +59,6 @@ type implementation -procedure THotSpringsFullDataTestCase.TestPart2; -begin - AssertEquals(-1, FSolver.GetResultPart2); -end; - { THotSpringsExampleTestCase } function THotSpringsExampleTestCase.CreateSolver: ISolver;