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