AdventOfCode2023/solvers/UHotSprings.pas

821 lines
26 KiB
Plaintext
Raw Normal View History

{
Solutions to the Advent Of Code.
2024-10-15 11:45:44 +02:00
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 <http://www.gnu.org/licenses/>.
}
unit UHotSprings;
{$mode ObjFPC}{$H+}
interface
// TODO: Remove this and the ifdefs.
{$define debug}
uses
2024-11-09 23:17:47 +01:00
Classes, SysUtils, Math, Generics.Collections, USolver, UCommon, UMultiIndexEnumerator, UBinomialCoefficients;
const
COperationalChar = '.';
CDamagedChar = '#';
CWildcardChar = '?';
CPart2Repetition = 5;
type
2024-10-15 11:45:44 +02:00
TValidationLengths = array of array of Integer;
2024-11-09 00:42:11 +01:00
// TODO: TIntegerArray probably not needed.
2024-10-15 11:45:44 +02:00
TIntegerArray = array of Integer;
{ TDamage }
TDamage = record
Start, Length, CharsRemaining: Integer;
2024-10-15 11:45:44 +02:00
end;
TDamages = specialize TList<TDamage>;
{ 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<TBlock>;
2024-10-15 11:45:44 +02:00
{ TDamageToValidationAssignments }
2024-11-09 00:42:11 +01:00
TDamageToValidationAssignments = class(TEnumerableMultiIndexStrategy)
2024-11-09 00:42:11 +01:00
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;
2024-11-09 00:42:11 +01:00
end;
TValidationPositionInfos = specialize TList<TValidationPositionInfo>;
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;
2024-11-09 00:42:11 +01:00
{ TValidationPositionOffsets }
TValidationPositionOffsets = class(TAccumulatedCombinationsMultiIndexStrategy)
2024-11-09 00:42:11 +01:00
private
FConditionRecord: TConditionRecord;
2024-11-09 00:42:11 +01:00
FPositionInfos: TValidationPositionInfos;
FBlockLength, FStartIndex, FStopIndex: Integer;
protected
function CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): Int64; override;
2024-11-09 00:42:11 +01:00
public
constructor Create(constref AConditionRecord: TConditionRecord; constref APositionInfos: TValidationPositionInfos;
const ABlockLength, AStartIndex, AStopIndex: Integer);
2024-11-09 00:42:11 +01:00
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;
2024-10-15 11:45:44 +02:00
{ TConditionRecord }
TConditionRecord = class
private
2024-10-15 11:45:44 +02:00
FValidation: TIntegerList;
2024-11-09 00:42:11 +01:00
// List of non-empty, maximum-length parts of the pattern without operational springs ("blocks").
FBlocks: TBlocks;
2024-11-09 00:42:11 +01:00
// Array 'a' of accumulated validation series lengths. 'a[i, j]' denotes the combined length of consecutive
2024-10-15 11:45:44 +02:00
// 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'
2024-11-09 00:42:11 +01:00
// cannot fit into the remaining blocks starting at 'FBlocks[i]'.
2024-10-15 11:45:44 +02:00
FMinIndices: TIntegerArray;
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;
public
constructor Create;
destructor Destroy; override;
2024-11-09 00:42:11 +01:00
// Adds all non-empty, maximum-length parts of the pattern without operational springs ("blocks").
procedure AddBlocks(const APattern: string);
2024-10-15 11:45:44 +02:00
function GenerateBlockAssignments: Int64;
function CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer): Int64;
property Validation: TIntegerList read FValidation;
2024-10-15 11:45:44 +02:00
end;
{ THotSprings }
THotSprings = class(TSolver)
2024-11-09 23:17:47 +01:00
private
// TODO: Remove FDebugIndex.
FDebugIndex: Integer;
2024-10-15 11:45:44 +02:00
public
2024-11-09 23:17:47 +01:00
constructor Create;
destructor Destroy; override;
procedure ProcessDataLine(const ALine: string); override;
procedure Finish; override;
function GetDataFileName: string; override;
function GetPuzzleName: string; override;
end;
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;
{ TDamageToValidationAssignments }
2024-11-09 00:42:11 +01:00
function TDamageToValidationAssignments.CalcValidationSpan(constref ACurrentIndexArray: TIndexArray;
2024-11-09 00:42:11 +01:00
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 TDamageToValidationAssignments.Create(constref AValidation: TIntegerList; constref AValidationLengths:
2024-11-09 00:42:11 +01:00
TValidationLengths; constref ADamages: TDamages; const AStartIndex, AStopIndex: Integer);
begin
FValidation := AValidation;
FValidationLengths := AValidationLengths;
FDamages := ADamages;
FValidationStartIndex := AStartIndex;
FValidationStopIndex := AStopIndex;
end;
function TDamageToValidationAssignments.GetCardinality: Integer;
2024-11-09 00:42:11 +01:00
begin
Result := FDamages.Count;
end;
function TDamageToValidationAssignments.TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray;
2024-11-09 00:42:11 +01:00
const ACurrentIndex: Integer; out AStartIndexValue: Integer): Boolean;
begin
Result := True;
if ACurrentIndex > 0 then
AStartIndexValue := ACurrentIndexArray[ACurrentIndex - 1]
else
AStartIndexValue := FValidationStartIndex;
end;
function TDamageToValidationAssignments.ValidateIndexValue(constref ACurrentIndexArray: TIndexArray;
2024-11-09 00:42:11 +01:00
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
2024-11-09 00:42:11 +01:00
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
2024-11-09 00:42:11 +01:00
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;
{ 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;
2024-11-09 00:42:11 +01:00
{ TValidationPositionOffsets }
function TValidationPositionOffsets.CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex:
Integer): Int64;
var
space, start, stop: Integer;
2024-11-09 00:42:11 +01:00
begin
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;
2024-11-09 00:42:11 +01:00
FPositionInfos := APositionInfos;
FBlockLength := ABlockLength;
FStartIndex := AStartIndex;
FStopIndex := AStopIndex;
inherited Create;
2024-11-09 00:42:11 +01:00
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.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] + FConditionRecord.Validation[FPositionInfos[ACurrentIndex - 1].ValidationIndex] + 1);
2024-11-09 00:42:11 +01:00
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;
Result := UpdateCombinations(Result, ACurrentIndexArray, ACurrentIndex);
2024-11-09 00:42:11 +01:00
end;
2024-10-15 11:45:44 +02:00
{ 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
2024-11-09 00:42:11 +01:00
SetLength(FMinIndices, FBlocks.Count - 1);
patternsLength := Length(FBlocks[FBlocks.Count - 1].Pattern);
2024-10-15 11:45:44 +02:00
j := FValidation.Count;
2024-11-09 00:42:11 +01:00
for i := FBlocks.Count - 2 downto 0 do
2024-10-15 11:45:44 +02:00
begin
while (j >= 0) and (FValidationLengths[j, FValidation.Count] <= patternsLength) do
Dec(j);
FMinIndices[i] := j + 1;
patternsLength := patternsLength + 1 + Length(FBlocks[i].Pattern);
2024-10-15 11:45:44 +02:00
end;
end;
2024-10-15 11:45:44 +02:00
function TConditionRecord.CalcCombinations(constref AIndices: TIntegerArray): Int64;
var
i, j: Integer;
// TODO: Remove r.
r: Int64;
begin
{$ifdef debug}
2024-10-15 11:45:44 +02:00
for i in AIndices do
Write(i, ' ');
WriteLn;
{$endif}
2024-10-15 11:45:44 +02:00
Result := 1;
i := 0;
2024-11-09 00:42:11 +01:00
while (Result > 0) and (i < FBlocks.Count) do
2024-10-15 11:45:44 +02:00
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;
2024-10-15 11:45:44 +02:00
Inc(i);
end;
end;
function TConditionRecord.CalcCombinationsBlock(constref ABlock: TBlock; const AStartIndex, AStopIndex: Integer): Int64;
2024-10-15 11:45:44 +02:00
var
i, j, k: Integer;
2024-11-09 00:42:11 +01:00
indices: TIndexArray;
validationToDamageAssignments: TDamageToValidationAssignments;
2024-10-15 11:45:44 +02:00
begin
{$ifdef debug}
Write(' ', ABlock.Pattern, ' ');
2024-10-15 11:45:44 +02:00
for i := AStartIndex to AStopIndex do
Write(FValidation[i], ' ');
WriteLn;
{$endif}
2024-10-15 11:45:44 +02:00
// No validation number assigned to this block.
if AStartIndex > AStopIndex then
begin
if ABlock.Damages.Count = 0 then
2024-10-15 11:45:44 +02:00
Result := 1
else
Result := 0;
end
// One validation number assigned to this block.
else if AStartIndex = AStopIndex then
Result := CalcCombinationsBlockSingleValidation(ABlock, AStartIndex)
2024-10-15 11:45:44 +02:00
// Multiple validation numbers assigned to this block.
else begin
{$ifdef debug}
2024-10-15 11:45:44 +02:00
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);
2024-10-15 11:45:44 +02:00
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)
2024-10-15 11:45:44 +02:00
// Enough space after damage for the other validation numbers?
and (FValidationLengths[j, AStopIndex + 1] - FValidation[j] <= ABlock.Damages[i].CharsRemaining)
2024-10-15 11:45:44 +02:00
// Damage itself small enough for this validation number?
and (FValidation[j] >= ABlock.Damages[i].Length) then
2024-10-15 11:45:44 +02:00
Write(j - AStartIndex, ' ');
WriteLn;
end;
{$endif}
2024-10-15 11:45:44 +02:00
2024-11-09 23:17:47 +01:00
Result := 0;
2024-10-15 11:45:44 +02:00
// Assigns validation numbers to specific damages.
validationToDamageAssignments := TDamageToValidationAssignments.Create(FValidation, FValidationLengths, ABlock.Damages,
2024-11-09 00:42:11 +01:00
AStartIndex, AStopIndex);
{$ifdef debug}
2024-11-09 00:42:11 +01:00
WriteLn(' validation numbers (indices) per damages:');
{$endif}
2024-11-09 00:42:11 +01:00
for indices in validationToDamageAssignments do
begin
{$ifdef debug}
2024-11-09 00:42:11 +01:00
Write(' ');
for i := 0 to ABlock.Damages.Count - 1 do
2024-11-09 00:42:11 +01:00
Write(FValidation[indices[i]], ' ');
Write('( ');
for i := 0 to ABlock.Damages.Count - 1 do
2024-11-09 00:42:11 +01:00
Write(indices[i] - AStartIndex, ' ');
WriteLn(')');
{$endif}
Result := Result + CalcCombinationsBlockMultiValidations(ABlock, indices, AStartIndex, AStopIndex);
2024-10-15 11:45:44 +02:00
end;
2024-11-09 00:42:11 +01:00
validationToDamageAssignments.Free;
end;
end;
function TConditionRecord.CalcCombinationsBlockSingleValidation(constref ABlock: TBlock; const AIndex: Integer): Int64;
2024-10-15 11:45:44 +02:00
var
len, combinedDamagesLength: Integer;
begin
len := Length(ABlock.Pattern);
if len < FValidation[AIndex] then
2024-10-15 11:45:44 +02:00
Result := 0
else if ABlock.Damages.Count = 0 then
Result := len - FValidation[AIndex] + 1
2024-10-15 11:45:44 +02:00
else begin
combinedDamagesLength := ABlock.Damages.Last.Start + ABlock.Damages.Last.Length - ABlock.Damages.First.Start;
2024-10-15 11:45:44 +02:00
if FValidation[AIndex] < combinedDamagesLength then
Result := 0
else begin
Result := Min(Min(Min(
ABlock.Damages.First.Start,
2024-10-15 11:45:44 +02:00
FValidation[AIndex] - combinedDamagesLength + 1),
len - FValidation[AIndex] + 1),
ABlock.Damages.Last.CharsRemaining + 1);
2024-10-15 11:45:44 +02:00
end;
end;
end;
function TConditionRecord.CalcCombinationsBlockMultiValidations(constref ABlock: TBlock; constref AIndices:
TIndexArray; const AStartIndex, AStopIndex: Integer): Int64;
2024-11-09 00:42:11 +01:00
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 := ABlock.Damages[0].Start;
2024-11-09 00:42:11 +01:00
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, ABlock.Damages[i].Start - 1 - FValidation[position.ValidationIndex]);
2024-11-09 00:42:11 +01:00
position.MinStart := Max(position.MinStart,
ABlock.Damages[i - 1].Start + ABlock.Damages[i - 1].Length - FValidation[position.ValidationIndex]);
2024-11-09 00:42:11 +01:00
positions.Add(position);
// Initializes next info record.
position.ValidationIndex := AIndices[i];
position.MaxStart := ABlock.Damages[i].Start;
position.MinStart := position.MinStart + FValidationLengths[AIndices[i - 1], AIndices[i]] + 1;
2024-11-09 00:42:11 +01:00
end;
// Finalizes last info record.
position.MaxStart := Min(position.MaxStart, Length(ABlock.Pattern) + 1 - FValidation[position.ValidationIndex]);
2024-11-09 00:42:11 +01:00
position.MinStart := Max(position.MinStart,
ABlock.Damages[high].Start + ABlock.Damages[high].Length - FValidation[position.ValidationIndex]);
2024-11-09 00:42:11 +01:00
positions.Add(position);
{$ifdef debug}
2024-11-09 00:42:11 +01:00
WriteLn(' validation position infos');
for position in positions do
WriteLn(' ', position.ValidationIndex, ' ', position.MinStart, ' ', position.MaxStart);
WriteLn(' offsets');
{$endif}
2024-11-09 23:17:47 +01:00
Result := 0;
validationPositionOffsets := TValidationPositionOffsets.Create(Self, positions, Length(ABlock.Pattern),
AStartIndex, AStopIndex);
2024-11-09 00:42:11 +01:00
for offsets in validationPositionOffsets do
Result := Result + validationPositionOffsets.GetCombinations;
2024-11-09 00:42:11 +01:00
validationPositionOffsets.Free;
positions.Free;
end;
constructor TConditionRecord.Create;
2024-11-09 00:42:11 +01:00
begin
FBlocks := TBlocks.Create;
2024-10-15 11:45:44 +02:00
FValidation := TIntegerList.Create;
end;
2024-10-15 11:45:44 +02:00
destructor TConditionRecord.Destroy;
begin
2024-11-09 00:42:11 +01:00
FBlocks.Free;
FValidation.Free;
inherited Destroy;
end;
2024-11-09 00:42:11 +01:00
procedure TConditionRecord.AddBlocks(const APattern: string);
var
split: TStringArray;
2024-10-15 11:45:44 +02:00
part: string;
begin
2024-10-15 11:45:44 +02:00
split := APattern.Split([COperationalChar]);
for part in split do
if Length(part) > 0 then
FBlocks.Add(TBlock.Create(part));
2024-10-15 11:45:44 +02:00
end;
2024-10-15 11:45:44 +02:00
function TConditionRecord.GenerateBlockAssignments: Int64;
var
indices: array of Integer;
i, j, k, high: Integer;
// TODO: Remove r, count, misses.
r: Int64;
count, misses: Integer;
2024-10-15 11:45:44 +02:00
begin
count := 0;
misses := 0;
2024-10-15 11:45:44 +02:00
// 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;
2024-11-09 00:42:11 +01:00
SetLength(indices, FBlocks.Count + 1);
2024-10-15 11:45:44 +02:00
high := Length(indices) - 2;
indices[0] := 0;
indices[high + 1] := FValidation.Count;
2024-11-09 00:42:11 +01:00
// TODO: Use TMultiIndexEnumerator for this.
2024-10-15 11:45:44 +02:00
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].Pattern) do
2024-10-15 11:45:44 +02:00
begin
Dec(i);
Inc(indices[i]);
end;
Inc(i);
end;
Inc(count);
r := CalcCombinations(indices);
if r = 0 then
Inc(misses);
Result := Result + r;
2024-10-15 11:45:44 +02:00
k := high;
while (k > 0)
and ((indices[k] = FValidation.Count)
or (FValidationLengths[indices[k - 1], indices[k] + 1] > Length(FBlocks[k - 1].Pattern))) do
2024-10-15 11:45:44 +02:00
Dec(k);
Inc(indices[k]);
until k = 0;
WriteLn(' missed: ', misses, '/', count);
2024-10-15 11:45:44 +02:00
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;
2024-10-15 11:45:44 +02:00
{ THotSprings }
2024-11-09 23:17:47 +01:00
constructor THotSprings.Create;
begin
FDebugIndex := 0;
2024-11-09 23:17:47 +01:00
end;
destructor THotSprings.Destroy;
begin
inherited Destroy;
end;
2024-10-15 11:45:44 +02:00
procedure THotSprings.ProcessDataLine(const ALine: string);
var
conditionRecord1, conditionRecord2: TConditionRecord;
mainSplit, split: TStringArray;
part, unfolded: string;
i: Integer;
begin
{$ifdef debug}
2024-10-15 11:45:44 +02:00
WriteLn(ALine);
WriteLn;
{$endif}
2024-10-15 11:45:44 +02:00
conditionRecord1 := TConditionRecord.Create;
conditionRecord2 := TConditionRecord.Create;
2024-10-15 11:45:44 +02:00
mainSplit := ALine.Split([' ']);
// Adds blocks for part 1.
2024-11-09 00:42:11 +01:00
conditionRecord1.AddBlocks(mainSplit[0]);
2024-10-15 11:45:44 +02:00
// Adds blocks for part 2.
unfolded := mainSplit[0];
for i := 2 to CPart2Repetition do
unfolded := unfolded + CWildcardChar + mainSplit[0];
2024-11-09 00:42:11 +01:00
conditionRecord2.AddBlocks(unfolded);
2024-10-15 11:45:44 +02:00
// 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;
2024-10-15 11:45:44 +02:00
FPart2 := FPart2 + conditionRecord2.GenerateBlockAssignments;
conditionRecord1.Free;
conditionRecord2.Free;
{$ifdef debug}
2024-10-15 11:45:44 +02:00
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.