{ Solutions to the Advent Of Code. 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 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 UHotSprings; {$mode ObjFPC}{$H+} interface // TODO: Remove this and the ifdefs. {$define debug} uses Classes, SysUtils, Math, Generics.Collections, USolver, UCommon, UMultiIndexEnumerator, UBinomialCoefficients; const COperationalChar = '.'; CDamagedChar = '#'; CWildcardChar = '?'; CPart2Repetition = 5; type TValidationLengths = array of array of Integer; // TODO: TIntegerArray probably not needed. TIntegerArray = array of Integer; { TDamage } 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; { 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, MinStart, MaxStart: Integer; 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 FBinomialCoefficients: TBinomialCoefficientCache; FValidation: TIntegerList; // 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; // 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 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; end; { THotSprings } 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 constructor Create; destructor Destroy; override; procedure ProcessDataLine(const ALine: string); override; procedure Finish; override; function GetDataFileName: string; override; function GetPuzzleName: string; override; end; implementation { 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 (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 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; // 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; var i, j: Integer; begin 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; procedure TConditionRecord.InitMinIndices; var i, j, patternsLength: Integer; begin SetLength(FMinIndices, FBlocks.Count - 1); patternsLength := Length(FBlocks[FBlocks.Count - 1]); 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]); 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 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; function TConditionRecord.CalcCombinationsBlock(const ABlock: string; constref ADamages: TDamages; const AStartIndex, AStopIndex: Integer): Int64; var i, j, k: Integer; 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 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 := 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], ' '); 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 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; {$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]], ' '); Write('( '); 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; end; function TConditionRecord.CalcCombinationsBlockSingleValidation(const ABlockLength: Integer; constref ADamages: TDamages; const AIndex: Integer): Int64; var combinedDamagesLength: Integer; begin if ABlockLength < FValidation[AIndex] then Result := 0 else if ADamages.Count = 0 then Result := ABlockLength - 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), ABlockLength - FValidation[AIndex] + 1), ADamages.Last.CharsRemaining + 1); end; end; end; 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 - 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; 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); {$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 Result := Result + 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: 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 - 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; 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; FValidation := TIntegerList.Create; FDamagesBlocks := TDamagesBlocks.Create; end; destructor TConditionRecord.Destroy; begin FBlocks.Free; FValidation.Free; FDamagesBlocks.Free; inherited Destroy; end; procedure TConditionRecord.AddBlocks(const APattern: string); var split: TStringArray; part: string; begin split := APattern.Split([COperationalChar]); for part in split do if Length(part) > 0 then begin FBlocks.Add(part); FDamagesBlocks.Add(ParseDamages(part)); end; 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; 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 begin indices[i] := Max(indices[i - 1], FMinIndices[i - 1]); while FValidationLengths[indices[i - 1], indices[i]] > Length(FBlocks[i - 1]) do begin Dec(i); Inc(indices[i]); end; Inc(i); end; Inc(count); r := CalcCombinations(indices); if r = 0 then Inc(misses); Result := Result + r; k := high; while (k > 0) and ((indices[k] = FValidation.Count) or (FValidationLengths[indices[k - 1], indices[k] + 1] > Length(FBlocks[k - 1]))) do Dec(k); Inc(indices[k]); until k = 0; WriteLn(' missed: ', misses, '/', count); end; { THotSprings } constructor THotSprings.Create; begin FDebugIndex := 0; FBinomialCoefficients := TBinomialCoefficientCache.Create; end; destructor THotSprings.Destroy; begin FBinomialCoefficients.Free; inherited Destroy; end; procedure THotSprings.ProcessDataLine(const ALine: string); var conditionRecord1, conditionRecord2: TConditionRecord; mainSplit, split: TStringArray; part, unfolded: string; i: Integer; begin {$ifdef debug} WriteLn(ALine); WriteLn; {$endif} conditionRecord1 := TConditionRecord.Create(FBinomialCoefficients); conditionRecord2 := TConditionRecord.Create(FBinomialCoefficients); mainSplit := ALine.Split([' ']); // Adds blocks for part 1. conditionRecord1.AddBlocks(mainSplit[0]); // Adds blocks for part 2. unfolded := mainSplit[0]; for i := 2 to CPart2Repetition do unfolded := unfolded + CWildcardChar + mainSplit[0]; conditionRecord2.AddBlocks(unfolded); // Adds validation numbers. split := mainSplit[1].Split([',']); for part in split do conditionRecord1.Validation.Add(StrToInt(part)); 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; begin end; function THotSprings.GetDataFileName: string; begin Result := 'hot_springs.txt'; end; function THotSprings.GetPuzzleName: string; begin Result := 'Day 12: Hot Springs'; end; end.