AdventOfCode2023/solvers/UHotSprings.pas

{
  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 <http://www.gnu.org/licenses/>.
}

unit UHotSprings;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Math, Generics.Collections, USolver, UCommon, UMultiIndexEnumerator, UBinomialCoefficients;

const
  COperationalChar = '.';
  CDamagedChar = '#';
  CWildcardChar = '?';
  //COperationalPatternChars = [COperationalChar, CWildcardChar];
  //CDamagedPatternChars = [CDamagedChar, CWildcardChar];
  CPart2Repetition = 1;

type

  //{ TBlockAssignment }
  //
  //TBlockAssignment = class
  //private
  //  FPrevious: TBlockAssignment;
  //  FPattern: string;
  //  FValidation: TIntegerList;
  //public
  //  property Validation: TIntegerList read FValidation;
  //  constructor Create(const APattern: string; constref APrevious: TBlockAssignment = nil);
  //  destructor Destroy; override;
  //  procedure WriteDebug;
  //end;
  //
  //TBlockAssignments = specialize TObjectList<TBlockAssignment>;

  TValidationLengths = array of array of Integer;
  //TPatternLengths = array of Integer;
  // TODO: TIntegerArray probably not needed.
  TIntegerArray = array of Integer;

  { TDamage }

  TDamage = record
    Start, Length, CharsRemaining: Byte;
  end;

  TDamages = specialize TList<TDamage>;
  // TODO: Instead of using TDamagesBlocks, "block" should be a record of a string and its associated list TDamages.
  TDamagesBlocks = specialize TObjectList<TDamages>;

  { 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<TValidationPositionInfo>;

  { 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;

    //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;
    // 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 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:
      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;
  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

//{ 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;
  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;
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;

//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, 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: Integer;
begin
  for i in AIndices do
    Write(i, ' ');
  WriteLn;

  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);
    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
  Write('    ', ABlock, ' ');
  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 := CalcCombinationsBlockSingleValidation(Length(ABlock), ADamages, AStartIndex)
  // Multiple validation numbers assigned to this block.
  else begin
    ///////////////////////////////
    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;
    ///////////////////////////////

    Result := 0;

    // Assigns validation numbers to specific damages.
    validationToDamageAssignments := TValidationToDamageAssignments.Create(FValidation, FValidationLengths, ADamages,
      AStartIndex, AStopIndex);
    WriteLn('        validation numbers (indices) per damages:');
    for indices in validationToDamageAssignments do
    begin
      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(')');
      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:
  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 - 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');
  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
  Write('                      ');
  for i in AOffsets do
    Write(i, ' ');

  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;

  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;
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;
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;

  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
      ////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
        Dec(i);
        Inc(indices[i]);
      end;

      Inc(i);
    end;

    //if FValidationLengths[indices[0], indices[1]] > Length(FBlocks[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(FBlocks[k - 1]))) do
      Dec(k);
    Inc(indices[k]);
  until k = 0;
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;
  mainSplit, split: TStringArray;
  part, unfolded: string;
  i: Integer;
begin
  WriteLn(ALine);
  WriteLn;

  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);

  //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;
  FPart2 := FPart2 + conditionRecord2.GenerateBlockAssignments;

  conditionRecord1.Free;
  conditionRecord2.Free;

  WriteLn('------------------------');
  WriteLn;
end;

procedure THotSprings.Finish;
begin
  ProcessDataLine('?????#??##??????#??????? 5,3,1,2,1');
end;

function THotSprings.GetDataFileName: string;
begin
  Result := 'hot_springs.txt';
end;

function THotSprings.GetPuzzleName: string;
begin
  Result := 'Day 12: Hot Springs';
end;

end.