AdventOfCode2023/solvers/UHotSprings.pas

{
  Solutions to the Advent Of Code.
  Copyright (C) 2023  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, Generics.Collections, USolver;

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

type

  { THotSprings }

  THotSprings = class(TSolver)
  private
    FValidation: specialize TList<Integer>;
    FSpringPattern: string;
    procedure ExtendArrangement(const AArrangement: string; const ARemainingFreeOperationalCount, ACurrentValidationIndex:
      Integer);
    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;
    function GetPuzzleName: string; override;
  end;

implementation

{ THotSprings }

procedure THotSprings.ExtendArrangement(const AArrangement: string; const ARemainingFreeOperationalCount,
  ACurrentValidationIndex: Integer);
var
  match: Boolean;
  temp: string;
begin
  if Length(AArrangement) = Length(FSpringPattern) then
    Inc(FPart1)
  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);
    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]);

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

      if match then
        ExtendArrangement(temp, ARemainingFreeOperationalCount, ACurrentValidationIndex + 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;
var
  i, len: Integer;
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;
    end;
  end;
end;

constructor THotSprings.Create;
begin
  FValidation := specialize TList<Integer>.Create;
end;

destructor THotSprings.Destroy;
begin
  FValidation.Free;
  inherited Destroy;
end;

procedure THotSprings.ProcessDataLine(const ALine: string);
var
  split: TStringArray;
  i, val, maxFreeOperationalCount: Integer;
begin
  FValidation.Clear;
  split := ALine.Split([' ', ',']);
  FSpringPattern := split[0];

  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;

  ExtendArrangement('', maxFreeOperationalCount, 0);
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.