Updated day 12 WIP solver (correct solution)

AdventOfCode.lpi

@@ -157,6 +157,14 @@
         <Filename Value="UCommon.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="UMultiIndexEnumerator.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="UBinomialCoefficients.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

README.md

@@ -42,7 +42,7 @@ The algorithm processes the numbers in the middle line and looks for additional
 
 ### Day 4: Scratchcards
 
-:mag_right: Puzzle: <https://adventofcode.com/2023/day/4>, :white_check_mark: Solver: [`UScratchcards.pas`](solvers/UScratchcards.pas)
+:mag_right: Puzzle: <https://adventofcode.com/2023/day/4>, :white_check_mark: Solver: [`UScratchCards.pas`](solvers/UScratchCards.pas)
 
 For part 1, the algorithm simply matches winning numbers against numbers we have, and multiplies the current line result by two for every match (except the first).
 
@@ -152,7 +152,7 @@ The main modification to the classic algorithm here is that in order to calculat
 
 :star: :mag_right: Puzzle: <https://adventofcode.com/2023/day/18>, :white_check_mark: Solver: [`ULavaductLagoon.pas`](solvers/ULavaductLagoon.pas)
 
-My first algorithm for part 1 was a simply tracking the trench in a top-view two-dimensional array and then flood-filling the outside of the trench to determine the full area. It worked, but there were two problems. Firstly, I had to iteratre over the list of digs twice in order to avoid resizing the array frequently. Secondly, the performance complexity of the algorthim depends largely on the size of the array, i.e. the length of the individual digs, so obviously it did not scale for part 2.
+My first algorithm for part 1 was a simply tracking the trench in a top-view two-dimensional array and then flood-filling the outside of the trench to determine the full area. It worked, but there were two problems. Firstly, I had to iteratre over the list of digs twice in order to avoid resizing the array frequently. Secondly, the performance complexity of the algorthim depends largely on the size of the array, i.e. the length of the individual digs, so obviously it did not scale for part2.
 
 The final algorithm, uses the fact that either all right turns are convex or concave, locally, while all left turns are the opposite. That means that two consecutive turns in the same direction (a U-turn) enclose a rectangular area that is either inside or outside of the trench depending only on the direction of the two turns. So the algorthim simply collapses all U-turns it encounters into a straight dig instruction, thereby cutting of an area that is either added to or subtracted from the running area count.
 
@@ -166,24 +166,6 @@ Since the workflows are at the beginning of the puzzle input, each machine part
 
 For part two, a virtual "multi machine part" that represents all possible values of ratings, modelled as four integer intervals, is sent through the same workflow graph. Each time one of rules is applied to a multi machine part, it is split into up to three new multi machine parts that continue to go through the workflows on separate paths. This is similar to [my day 5 solution](#day-5-if-you-give-a-seed-a-fertilizer).
 
-### Day 20: Pulse Propagation
-
-:mag_right: Puzzle: <https://adventofcode.com/2023/day/20>, :white_check_mark: Solver: [`UPulsePropagation.pas`](solvers/UPulsePropagation.pas)
-
-For part 1, it's quite straight forward to model and simulate the module pulses for the first 1000 button pushes.
-
-Part 2 seemed pretty daunting at first (and probably is quite difficult in the general case), but investigating the graph of the module connection reveals pretty quickly that the modules form a set of four independent counters of button pushes modulo different reset values, such that `rx` receives one low pulse if and only if all four counters reset as a result of the same button push. Clearly, the first time this happens is when the button is pushed a number of times equal to the product of the four counters' reset values.
-
-### Day 21: Step Counter
-
-:mag_right: Puzzle: <https://adventofcode.com/2023/day/21>, :white_check_mark: Solver: [`UStepCounter.pas`](solvers/UStepCounter.pas)
-
-Part 1 can comfortably be solved with a flood-fill algorithm. Counting every other traversed plot will emulate the trivial backtracking the elf can do, without having to do the actual backtracking in the algorithm.
-
-For part 2, I noticed that the map is sparse enough so that all plots that are theoretically in range are also actually in reachable. This means that the algorithm only has to count empty plots within specific, different, disjoint areas on the map, and multiply them by the number of occurences of this piece of the map within the full shape of reachable plots. See [`UStepCounter.pas`, line 174](solvers/UStepCounter.pas#L174) for details.
-
-Interestingly, this is the only puzzle besides [day 20](#day-20-pulse-propagation), which had no part 2 example, where my implementation cannot solve the part 2 examples, since the example map is not sparse and their step limits do not fit the algorithm's requirements.
-
 ### Day 22: Sand Slabs
 
 :mag_right: Puzzle: <https://adventofcode.com/2023/day/22>, :white_check_mark: Solver: [`USandSlabs.pas`](solvers/USandSlabs.pas)
@@ -194,14 +176,6 @@ For part 1, if a brick lands on a single supporting brick, that brick below cann
 
 For part 2, given a starting brick, the algorithm makes use of the tracked vertical connections to find a group of bricks supported by it, such that all supports of the bricks in the group are also in the group. This group of bricks would fall if the starting brick was disintegrated, so its size is counted for each possible starting brick.
 
-### Day 23: A Long Walk
-
-:mag_right: Puzzle: <https://adventofcode.com/2023/day/23>, :white_check_mark: Solver: [`ULongWalk.pas`](solvers/ULongWalk.pas)
-
-There is a nice *O(|V| * |E|)* algorithm for the maximum flow in a directed acyclic graph, if a topological ordering of the vertices is know. It's relatively easy to parse the edges ("paths") of the long walk from the input such that a topological ordering results, by adding the vertices ("crossings") only after all in-edges have been found.
-
-For part 2, I believe there is no polynomial algorithm known for the general case, and even with the given restraints I was unable to come up with one. Instead, my solution uses a depth-first search to parse all options in the network. This was feasible for the given input with some smart data structures to limit iterations of the vertex or edge lists, and with shortcuts to determine early if a search branch can be abandoned.
-
 ### Day 24: Never Tell Me the Odds
 
 :star: :mag_right: Puzzle: <https://adventofcode.com/2023/day/24>, :white_check_mark: Solver: [`UNeverTellMeTheOdds.pas`](solvers/UNeverTellMeTheOdds.pas)

UBinomialCoefficients.pas

@@ -0,0 +1,96 @@
+{
+  Solutions to the Advent Of Code.
+  Copyright (C) 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 UBinomialCoefficients;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Generics.Collections;
+
+type
+  TCardinalArray = array of Cardinal;
+  TCardinalArrays = specialize TList<TCardinalArray>;
+
+  { TBinomialCoefficientCache }
+
+  TBinomialCoefficientCache = class
+  private
+    FCache: TCardinalArrays;
+    procedure AddRow;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    // Returns N choose K, with N >= K >= 0.
+    function Get(const AN, AK: Cardinal): Cardinal;
+    // Returns the number of cached rows C = N + 1, where N is the highest from previously queried "N choose K". The
+    // actual number of cached binomial coefficient values is C * (C + 1) / 2.
+    function GetCachedRowsCount: Cardinal;
+  end;
+
+implementation
+
+{ TBinomialCoefficientCache }
+
+procedure TBinomialCoefficientCache.AddRow;
+var
+  row: TCardinalArray;
+  i: Cardinal;
+begin
+  SetLength(row, FCache.Count + 1);
+  row[0] := 1;
+  if FCache.Count > 0 then
+  begin
+    row[FCache.Count] := 1;
+    for i := 1 to FCache.Count - 1 do
+      row[i] := FCache.Last[i - 1] + FCache.Last[i];
+  end;
+  FCache.Add(row);
+end;
+
+constructor TBinomialCoefficientCache.Create;
+begin
+  FCache := TCardinalArrays.Create;
+end;
+
+destructor TBinomialCoefficientCache.Destroy;
+begin
+  FCache.Free;
+  inherited Destroy;
+end;
+
+function TBinomialCoefficientCache.Get(const AN, AK: Cardinal): Cardinal;
+var
+  i: Cardinal;
+begin
+  if AN < AK then
+    raise ERangeError.Create('Cannot calculate binomial coefficient "n choose k" with k larger than n.');
+
+  for i := FCache.Count to AN do
+    AddRow;
+  Result := FCache[AN][AK];
+end;
+
+function TBinomialCoefficientCache.GetCachedRowsCount: Cardinal;
+begin
+  Result := FCache.Count;
+end;
+
+end.
+

UCommon.pas

@@ -41,7 +41,6 @@ const
 
 type
   TIntegerList = specialize TList<Integer>;
-  TPoints = specialize TList<TPoint>;
 
 implementation
 

UMultiIndexEnumerator.pas

@@ -0,0 +1,160 @@
+{
+  Solutions to the Advent Of Code.
+  Copyright (C) 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 UMultiIndexEnumerator;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+type
+  TIndexArray = array of Integer;
+
+  TIndexValidationResult = (ivrValid, ivrSkip, ivrBacktrack);
+
+  TEnumerableMultiIndexStrategy = class;
+
+  { TMultiIndexEnumerator }
+
+  TMultiIndexEnumerator = class(TInterfacedObject, specialize IEnumerator<TIndexArray>)
+  private
+    FStrategy: TEnumerableMultiIndexStrategy;
+    FCurrent: TIndexArray;
+    FMustInit: Boolean;
+    function UpdateArray(const AInit: Boolean): Boolean;
+  public
+    constructor Create(const AStrategy: TEnumerableMultiIndexStrategy);
+    function GetCurrent: TIndexArray;
+    function MoveNext: Boolean;
+    procedure Reset;
+    property Current: TIndexArray read GetCurrent;
+  end;
+
+  { TEnumerableMultiIndexStrategy }
+
+  TEnumerableMultiIndexStrategy = class(TInterfacedObject, specialize IEnumerable<TIndexArray>)
+  public
+    function GetEnumerator: specialize IEnumerator<TIndexArray>;
+    function GetCardinality: Integer; virtual; abstract;
+    function TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer;
+      out AStartIndexValue: Integer): Boolean; virtual; abstract;
+    function ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer):
+      TIndexValidationResult; virtual; abstract;
+  end;
+
+implementation
+
+{ TMultiIndexEnumerator }
+
+function TMultiIndexEnumerator.UpdateArray(const AInit: Boolean): Boolean;
+var
+  i, initialized: Integer;
+  r: TIndexValidationResult;
+begin
+  if AInit then
+  begin
+    i := 0;
+    initialized := -1;
+  end
+  else begin
+    i := Length(FCurrent) - 1;
+    initialized := i;
+  end;
+
+  while i < Length(FCurrent) do
+  begin
+    if initialized < i then
+    begin
+      // Checks whether start index value can be set, and backtracks or aborts if not.
+      if not FStrategy.TryGetStartIndexValue(FCurrent, i, FCurrent[i]) then
+        if i > 0 then
+        begin
+          Dec(i);
+          Continue;
+        end
+        else begin
+          Result := False;
+          Exit;
+        end
+    end
+    else
+      // Sets next candidate for current index value.
+      Inc(FCurrent[i]);
+
+    // Checks if current index value is valid, and increases it until it is, or backtracks or aborts if so indicated.
+    while True do
+    begin
+      r := FStrategy.ValidateIndexValue(FCurrent, i);
+      case r of
+        ivrValid: begin
+          initialized := i;
+          Inc(i);
+          Break;
+        end;
+        ivrSkip:
+          Inc(FCurrent[i]);
+        ivrBacktrack:
+          if i > 0 then
+          begin
+            Dec(i);
+            Break;
+          end
+          else begin
+            Result := False;
+            Exit;
+          end;
+      end;
+    end;
+  end;
+  Result := True;
+end;
+
+constructor TMultiIndexEnumerator.Create(const AStrategy: TEnumerableMultiIndexStrategy);
+begin
+  FStrategy := AStrategy;
+  SetLength(FCurrent, FStrategy.GetCardinality);
+  Reset;
+end;
+
+function TMultiIndexEnumerator.GetCurrent: TIndexArray;
+begin
+  Result := FCurrent;
+end;
+
+function TMultiIndexEnumerator.MoveNext: Boolean;
+begin
+  Result := UpdateArray(FMustInit);
+  FMustInit := False;
+end;
+
+procedure TMultiIndexEnumerator.Reset;
+begin
+  FMustInit := True;
+end;
+
+{ TEnumerableMultiIndexStrategy }
+
+function TEnumerableMultiIndexStrategy.GetEnumerator: specialize IEnumerator<TIndexArray>;
+begin
+  Result := TMultiIndexEnumerator.Create(Self);
+end;
+
+end.
+

solvers/UCosmicExpansion.pas

@@ -22,7 +22,7 @@ unit UCosmicExpansion;
 interface
 
 uses
-  Classes, SysUtils, Generics.Collections, Math, USolver, UCommon;
+  Classes, SysUtils, Generics.Collections, Math, USolver;
 
 const
   CGalaxyChar = '#';
@@ -36,8 +36,8 @@ type
   TCosmicExpansion = class(TSolver)
   private
     FExpansionFactor: Integer;
-    FColumnExpansion, FRowExpansion: TIntegerList;
-    FGalaxies: TPoints;
+    FColumnExpansion, FRowExpansion: specialize TList<Integer>;
+    FGalaxies: specialize TList<TPoint>;
     procedure InitColumnExpansion(const ASize: Integer);
   public
     constructor Create(const AExpansionFactor: Integer = 999999);
@@ -67,9 +67,9 @@ end;
 constructor TCosmicExpansion.Create(const AExpansionFactor: Integer);
 begin
   FExpansionFactor := AExpansionFactor;
-  FColumnExpansion := TIntegerList.Create;
-  FRowExpansion := TIntegerList.Create;
-  FGalaxies := TPoints.Create;
+  FColumnExpansion := specialize TList<Integer>.Create;
+  FRowExpansion := specialize TList<Integer>.Create;
+  FGalaxies := specialize TList<TPoint>.Create;
 end;
 
 destructor TCosmicExpansion.Destroy;

solvers/UHotSprings.pas

@@ -1,6 +1,6 @@
 {
   Solutions to the Advent Of Code.
-  Copyright (C) 2023  Stefan Müller
+  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
@@ -21,28 +21,128 @@ unit UHotSprings;
 
 interface
 
+// TODO: Remove this and the ifdefs.
+{$define debug}
+
 uses
-  Classes, SysUtils, Generics.Collections, USolver;
+  Classes, SysUtils, Math, Generics.Collections, USolver, UCommon, UMultiIndexEnumerator, UBinomialCoefficients;
 
 const
   COperationalChar = '.';
   CDamagedChar = '#';
   CWildcardChar = '?';
-  COperationalPatternChars = [COperationalChar, CWildcardChar];
-  CDamagedPatternChars = [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<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, MinStart, MaxStart: Integer;
+  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;
+    // 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
-    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;
+    // 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;
@@ -54,99 +154,604 @@ type
 
 implementation
 
-{ THotSprings }
+{ TValidationToDamageAssignments }
 
-procedure THotSprings.ExtendArrangement(const AArrangement: string; const ARemainingFreeOperationalCount,
-  ACurrentValidationIndex: Integer);
+function TValidationToDamageAssignments.CalcValidationSpan(constref ACurrentIndexArray: TIndexArray;
+  const ALastDamageIndex, AValidationNumber: Integer): Integer;
 var
-  match: Boolean;
-  temp: string;
+  spanStart: Integer;
 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;
+  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;
 
-function THotSprings.TryAppendOperationalChar(var AArrangement: string): Boolean;
+constructor TValidationToDamageAssignments.Create(constref AValidation: TIntegerList; constref AValidationLengths:
+  TValidationLengths; constref ADamages: TDamages; const AStartIndex, AStopIndex: Integer);
 begin
-  if FSpringPattern[Length(AArrangement) + 1] in COperationalPatternChars then
-  begin
-    AArrangement := AArrangement + COperationalChar;
-    Result := True;
-  end
-  else
-    Result := False;
+  FValidation := AValidation;
+  FValidationLengths := AValidationLengths;
+  FDamages := ADamages;
+  FValidationStartIndex := AStartIndex;
+  FValidationStopIndex := AStopIndex;
 end;
 
-function THotSprings.TryAppendValidationBlock(var AArrangement: string; const ALength: Integer): Boolean;
-var
-  i, len: Integer;
+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;
-  len := Length(AArrangement);
-  for i := 1 to ALength do
+  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
-    if FSpringPattern[len + i] in CDamagedPatternChars then
-      AArrangement := AArrangement + CDamagedChar
+    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
-      Result := False;
-      Break;
+      {$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
-  FValidation := specialize TList<Integer>.Create;
+  FDebugIndex := 0;
+  FBinomialCoefficients := TBinomialCoefficientCache.Create;
 end;
 
 destructor THotSprings.Destroy;
 begin
-  FValidation.Free;
+  FBinomialCoefficients.Free;
   inherited Destroy;
 end;
 
 procedure THotSprings.ProcessDataLine(const ALine: string);
 var
-  split: TStringArray;
-  i, val, maxFreeOperationalCount: Integer;
+  conditionRecord1, conditionRecord2: TConditionRecord;
+  mainSplit, split: TStringArray;
+  part, unfolded: string;
+  i: Integer;
 begin
-  FValidation.Clear;
-  split := ALine.Split([' ', ',']);
-  FSpringPattern := split[0];
+  {$ifdef debug}
+  WriteLn(ALine);
+  WriteLn;
+  {$endif}
 
-  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;
+  conditionRecord1 := TConditionRecord.Create(FBinomialCoefficients);
+  conditionRecord2 := TConditionRecord.Create(FBinomialCoefficients);
 
-  ExtendArrangement('', maxFreeOperationalCount, 0);
+  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;

solvers/ULongWalk.pas

@@ -25,23 +25,20 @@ uses
   Classes, SysUtils, Generics.Collections, USolver, UCommon;
 
 type
-  TCrossing = class;
+  TPoints = specialize TList<TPoint>;
 
-  TPathSelectionState = (pssNone, pssIncluded, pssExcluded);
+  TCrossing = class;
 
   { TPath }
 
   TPath = class
   private
-    FStart, FEnd: TCrossing;
+    FEnd: TCrossing;
     FLength: Integer;
-    FSelected: TPathSelectionState;
   public
-    property StartCrossing: TCrossing read FStart;
     property EndCrossing: TCrossing read FEnd;
     property Length: Integer read FLength;
-    property Selected: TPathSelectionState read FSelected write FSelected;
-    constructor Create(const ALength: Integer; const AStart, AEnd: TCrossing);
+    constructor Create(const ALength: Integer; const AEnd: TCrossing);
   end;
 
   TPaths = specialize TObjectList<TPath>;
@@ -60,51 +57,20 @@ type
   TCrossing = class
   private
     FPosition: TPoint;
-    FOutPaths, FPaths: TPaths;
+    FOutPaths: TPaths;
     FDistance: Integer;
-    FNotExcludedDegree: Integer;
   public
     property Position: TPoint read FPosition;
     property OutPaths: TPaths read FOutPaths;
-    property Paths: TPaths read FPaths;
     property Distance: Integer read FDistance write FDistance;
-    property NotExcludedDegree: Integer read FNotExcludedDegree write FNotExcludedDegree;
-    function CalcNextPickIndex(const AMinIndex: Integer): Integer;
     constructor Create(constref APosition: TPoint);
     destructor Destroy; override;
     procedure AddOutPath(const AOutPath: TPath);
-    procedure AddInPath(const AInPath: TPath);
   end;
 
   TCrossings = specialize TObjectList<TCrossing>;
   TCrossingStack = specialize TStack<TCrossing>;
 
-  TPathChoiceResult = (pcrContinue, pcrTargetReached, pcrTargetUnreachable, pcrNoMinimum);
-
-  { TPathChoice }
-
-  TPathChoice = class
-  private
-    FPrevious: TPathChoice;
-    FPickIndex: Integer;
-    FPick: TPath;
-    FEndCrossing: TCrossing;
-    FAutoExcludes: TPaths;
-    FExcludeCost: Int64;
-    FIncludeCost: Int64;
-  public
-    property PickIndex: Integer read FPickIndex;
-    property EndCrossing: TCrossing read FEndCrossing;
-    property IncludeCost: Int64 read FIncludeCost;
-    function Apply(constref ATargetCrossing: TCrossing; const AExcludeCostLimit: Int64): TPathChoiceResult;
-    procedure Revert;
-    constructor Create(const AStartCrossing: TCrossing);
-    constructor Create(const APickIndex: Integer; const APrevious: TPathChoice = nil);
-    destructor Destroy; override;
-  end;
-
-  TPathChoiceStack = specialize TStack<TPathChoice>;
-
   { TLongWalk }
 
   TLongWalk = class(TSolver)
@@ -112,15 +78,12 @@ type
     FLines: TStringList;
     FPaths: TPaths;
     FCrossings, FWaitingForOtherInPath: TCrossings;
-    FPathLengthSum: Int64;
+    FStart: TCrossing;
     function GetPosition(constref APoint: TPoint): Char;
     procedure ProcessPaths;
     procedure StepPath(const AStartPositionQueue: TPathStartQueue);
     function FindOrCreateCrossing(constref APosition: TPoint; const AStartPositionQueue: TPathStartQueue): TCrossing;
-    // Treats the graph as directed for part 1.
     procedure FindLongestPath;
-    // Treats the graph as undirected for part 2.
-    procedure FindLongestPathIgnoreSlopes;
   public
     constructor Create;
     destructor Destroy; override;
@@ -140,163 +103,30 @@ implementation
 
 { TPath }
 
-constructor TPath.Create(const ALength: Integer; const AStart, AEnd: TCrossing);
+constructor TPath.Create(const ALength: Integer; const AEnd: TCrossing);
 begin
   FLength := ALength;
-  FStart := AStart;
   FEnd := AEnd;
-  FSelected := pssNone;
 end;
 
 { TCrossing }
 
-function TCrossing.CalcNextPickIndex(const AMinIndex: Integer): Integer;
-begin
-  Result := AMinIndex;
-  while (Result < FPaths.Count) and (FPaths[Result].Selected <> pssNone) do
-    Inc(Result);
-end;
-
 constructor TCrossing.Create(constref APosition: TPoint);
 begin
   FPosition := APosition;
   FOutPaths := TPaths.Create(False);
-  FPaths := TPaths.Create(False);
   FDistance := 0;
-  FNotExcludedDegree := 0;
 end;
 
 destructor TCrossing.Destroy;
 begin
   FOutPaths.Free;
-  FPaths.Free;
   inherited Destroy;
 end;
 
 procedure TCrossing.AddOutPath(const AOutPath: TPath);
 begin
   FOutPaths.Add(AOutPath);
-  FPaths.Add(AOutPath);
-  Inc(FNotExcludedDegree);
-end;
-
-procedure TCrossing.AddInPath(const AInPath: TPath);
-begin
-  FPaths.Add(AInPath);
-  Inc(FNotExcludedDegree);
-end;
-
-{ TPathChoice }
-
-function TPathChoice.Apply(constref ATargetCrossing: TCrossing; const AExcludeCostLimit: Int64): TPathChoiceResult;
-var
-  path: TPath;
-  excludeStack: TCrossingStack;
-  crossing, otherCrossing: TCrossing;
-begin
-  Result := pcrContinue;
-
-  // Includes the selected path (edge) and checks whether target has been reached.
-  FPick.Selected := pssIncluded;
-  if FEndCrossing = ATargetCrossing then
-    Result := pcrTargetReached
-  else if FPrevious <> nil then
-  begin
-    // If the target has not been reached, starts at the starting crossing (which is the same as FPRevious.EndCrossing)
-    // and recursively excludes other connected paths (edges).
-    excludeStack := TCrossingStack.Create;
-    excludeStack.Push(FPrevious.EndCrossing);
-
-    while excludeStack.Count > 0 do
-    begin
-      crossing := excludeStack.Pop;
-      for path in crossing.Paths do
-        if path.Selected = pssNone then
-        begin
-          // Checks whether the path (edge) to the target crossing has been excluded and if so exits. The input data
-          // should be such that there is only one such path.
-          // The last crossing is always an end, never a start of a path (edge).
-          if path.EndCrossing = ATargetCrossing then
-          begin
-            Result := pcrTargetUnreachable;
-            excludeStack.Free;
-            Exit;
-          end
-          else begin
-            // Excludes the path (edge).
-            path.Selected := pssExcluded;
-            crossing.NotExcludedDegree := crossing.NotExcludedDegree - 1;
-            FAutoExcludes.Add(path);
-            FExcludeCost := FExcludeCost + path.Length;
-
-            // Checks if this choice is worse than the current best.
-            if FExcludeCost >= AExcludeCostLimit then
-            begin
-              Result := pcrNoMinimum;
-              excludeStack.Free;
-              Exit;
-            end;
-
-            // Finds the crossing on the other side, updates it, and possibly pushes it for recursion.
-            if crossing = path.StartCrossing then
-              otherCrossing := path.EndCrossing
-            else
-              otherCrossing := path.StartCrossing;
-
-            otherCrossing.NotExcludedDegree := otherCrossing.NotExcludedDegree - 1;
-            if otherCrossing.NotExcludedDegree < 2 then
-              excludeStack.Push(otherCrossing);
-          end;
-        end;
-    end;
-
-    excludeStack.Free;
-  end;
-end;
-
-procedure TPathChoice.Revert;
-var
-  path: TPath;
-begin
-  FPick.Selected := pssNone;
-  for path in FAutoExcludes do begin
-    path.Selected := pssNone;
-    path.StartCrossing.NotExcludedDegree := path.StartCrossing.NotExcludedDegree + 1;
-    path.EndCrossing.NotExcludedDegree := path.EndCrossing.NotExcludedDegree + 1;
-  end;
-end;
-
-constructor TPathChoice.Create(const AStartCrossing: TCrossing);
-begin
-  FPrevious := nil;
-  FPickIndex := 0;
-  FPick := AStartCrossing.Paths[FPickIndex];
-  FEndCrossing := FPick.EndCrossing;
-  FExcludeCost := 0;
-  FIncludeCost := FPick.FLength;
-  FAutoExcludes := TPaths.Create(False);
-end;
-
-constructor TPathChoice.Create(const APickIndex: Integer; const APrevious: TPathChoice);
-begin
-  FPrevious := APrevious;
-  FPickIndex := APickIndex;
-  FPick := FPrevious.EndCrossing.Paths[FPickIndex];
-
-  if FPick.StartCrossing = FPrevious.EndCrossing then
-    FEndCrossing := FPick.EndCrossing
-  else
-    FEndCrossing := FPick.StartCrossing;
-
-  FExcludeCost := FPrevious.FExcludeCost;
-  FIncludeCost := FPrevious.FIncludeCost + FPick.FLength;
-  FAutoExcludes := TPaths.Create(False);
-end;
-
-destructor TPathChoice.Destroy;
-begin
-  FAutoExcludes.Free;
-  inherited Destroy;
 end;
 
 { TLongWalk }
@@ -308,17 +138,17 @@ end;
 
 procedure TLongWalk.ProcessPaths;
 var
-  queue: TPathStartQueue;
+  stack: TPathStartQueue;
   pathStart: TPathStart;
 begin
-  queue := TPathStartQueue.Create;
-  pathStart.Crossing := FCrossings.First;
-  pathStart.Position := FCrossings.First.Position;
+  stack := TPathStartQueue.Create;
+  pathStart.Position := FStart.Position;
+  pathStart.Crossing := FStart;
   pathStart.ReverseDirection := CDirectionUp;
-  queue.Enqueue(pathStart);
-  while queue.Count > 0 do
-    StepPath(queue);
-  queue.Free;
+  stack.Enqueue(pathStart);
+  while stack.Count > 0 do
+    StepPath(stack);
+  stack.Free;
 end;
 
 procedure TLongWalk.StepPath(const AStartPositionQueue: TPathStartQueue);
@@ -333,8 +163,8 @@ var
   path: TPath;
 begin
   start := AStartPositionQueue.Dequeue;
-  len := 0;
-  if start.Crossing <> FCrossings.First then
+  len := 1;
+  if start.Crossing <> FStart then
     Inc(len);
   oneMore := False;
   stop := False;
@@ -362,11 +192,9 @@ begin
   until stop;
 
   crossing := FindOrCreateCrossing(start.Position, AStartPositionQueue);
-  path := TPath.Create(len, start.Crossing, crossing);
-  FPathLengthSum := FPathLengthSum + path.FLength;
+  path := TPath.Create(len, crossing);
   FPaths.Add(path);
   start.Crossing.AddOutPath(path);
-  crossing.AddInPath(path);
 end;
 
 // Crossing with multiple (two) entries will only be added to FCrossings once both in-paths have been processed. This
@@ -429,8 +257,6 @@ begin
   end
 end;
 
-// In a directed graph with a topological ordering on the crossings (vertices), the maximum distance can be computed
-// simply by traversing the crossings in that order and calculating the maximum locally.
 procedure TLongWalk.FindLongestPath;
 var
   crossing: TCrossing;
@@ -440,82 +266,17 @@ begin
   begin
     for path in crossing.OutPaths do
       if path.EndCrossing.Distance < crossing.Distance + path.Length then
-        path.EndCrossing.Distance := crossing.Distance + path.Length + 1;
+        path.EndCrossing.Distance := crossing.Distance + path.Length;
   end;
   FPart1 := FCrossings.Last.Distance;
 end;
 
-// For the undirected graph, we are running a DFS for the second to last crossing (vertex) with backtracking to find the
-// minimum of excluded crossings and paths.
-procedure TLongWalk.FindLongestPathIgnoreSlopes;
-var
-  pickIndex: Integer;
-  choice: TPathChoice;
-  stack: TPathChoiceStack;
-  minExcludeCost, newExcludeCost: Int64;
-begin
-  minExcludeCost := FPathLengthSum + FCrossings.Count - 1 - FPart1;
-
-  // Prepares the first pick, which is the only path connected to the first crossing.
-  stack := TPathChoiceStack.Create;
-  choice := TPathChoice.Create(FCrossings.First);
-  choice.Apply(FCrossings.Last, minExcludeCost);
-  stack.Push(choice);
-
-  // Runs a DFS for last crossing with backtracking, trying to find the minimum cost of excluded paths (i.e. edges).
-  pickIndex := -1;
-  while stack.Count > 0 do
-  begin
-    // Chooses next path.
-    pickIndex := stack.Peek.EndCrossing.CalcNextPickIndex(pickIndex + 1);
-    if pickIndex < stack.Peek.EndCrossing.Paths.Count then
-    begin
-      choice := TPathChoice.Create(pickIndex, stack.Peek);
-      case choice.Apply(FCrossings.Last, minExcludeCost) of
-        // Continues DFS, target has not yet been reached.
-        pcrContinue: begin
-          stack.Push(choice);
-          pickIndex := -1;
-          Continue;
-        end;
-        // Updates minimum and backtracks last choice, after target has been reached.
-        pcrTargetReached: begin
-          // Calculates new exclude cost based on path length sum and the choice's include cost. This effectively
-          // accounts for the "undecided" paths (edges) as well. Note that this does not actually need the choice's
-          // exclude costs, these are only required for the early exit in TPathChoice.Apply().
-          newExcludeCost := FCrossings.Count - stack.Count - 2 + FPathLengthSum - choice.IncludeCost;
-          if minExcludeCost > newExcludeCost then
-            minExcludeCost := newExcludeCost;
-
-          choice.Revert;
-          choice.Free;
-        end;
-        // Backtracks last choice, after target has been excluded or exclude costs ran over the current best.
-        pcrTargetUnreachable, pcrNoMinimum: begin
-          choice.Revert;
-          choice.Free;
-        end;
-      end;
-    end
-    else begin
-      choice := stack.Pop;
-      pickIndex := choice.PickIndex;
-      choice.Revert;
-      choice.Free;
-    end;
-  end;
-  stack.Free;
-
-  FPart2 := FPathLengthSum - minExcludeCost + FCrossings.Count - 1;
-end;
-
 constructor TLongWalk.Create;
 begin
   FLines := TStringList.Create;
   FPaths := TPaths.Create;
   FCrossings := TCrossings.Create;
   FWaitingForOtherInPath := TCrossings.Create(False);
-  FPathLengthSum := 0;
 end;
 
 destructor TLongWalk.Destroy;
@@ -530,7 +291,10 @@ end;
 procedure TLongWalk.ProcessDataLine(const ALine: string);
 begin
   if FLines.Count = 0 then
-    FCrossings.Add(TCrossing.Create(Point(ALine.IndexOf(CPathChar) + 1, 0)));
+  begin
+    FStart := TCrossing.Create(Point(ALine.IndexOf(CPathChar) + 1, 0));
+    FCrossings.Add(FStart);
+  end;
   FLines.Add(ALine);
 end;
 
@@ -538,7 +302,6 @@ procedure TLongWalk.Finish;
 begin
   ProcessPaths;
   FindLongestPath;
-  FindLongestPathIgnoreSlopes;
 end;
 
 function TLongWalk.GetDataFileName: string;

solvers/UPulsePropagation.pas

@@ -1,6 +1,6 @@
 {
   Solutions to the Advent Of Code.
-  Copyright (C) 2023-2024  Stefan Müller
+  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
@@ -22,7 +22,7 @@ unit UPulsePropagation;
 interface
 
 uses
-  Classes, SysUtils, Generics.Collections, USolver;
+  Classes, SysUtils, Generics.Collections, Math, USolver;
 
 type
   TModule = class;
@@ -49,12 +49,12 @@ type
   public
     property Name: string read FName;
     property OutputNames: TStringList read FOutputNames;
-    property Outputs: TModules read FOutputs;
     constructor Create(const AName: string);
     destructor Destroy; override;
     procedure AddInput(const AInput: TModule); virtual;
     procedure AddOutput(const AOutput: TModule); virtual;
     function ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; virtual; abstract;
+    function IsOff: Boolean; virtual;
   end;
 
   { TBroadcasterModule }
@@ -71,29 +71,31 @@ type
     FState: Boolean;
   public
     function ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; override;
+    function IsOff: Boolean; override;
   end;
 
-  { TConjunctionInputBuffer }
+  { TConjectionBuffer }
 
-  TConjunctionInputBuffer = record
+  TConjectionBuffer = record
     Input: TModule;
     LastState: Boolean;
   end;
 
-  TConjunctionInputBuffers = specialize TList<TConjunctionInputBuffer>;
+  TConjectionBuffers = specialize TList<TConjectionBuffer>;
 
   { TConjunctionModule }
 
   TConjunctionModule = class(TModule)
   private
-    FInputBuffers: TConjunctionInputBuffers;
+    FInputBuffers: TConjectionBuffers;
     procedure UpdateInputBuffer(constref AInput: TModule; const AState: Boolean);
-    function AreAllBuffersHigh: Boolean;
+    function AreAllBuffersSame(const AIsHigh: Boolean): Boolean;
   public
     constructor Create(const AName: string);
     destructor Destroy; override;
     procedure AddInput(const AInput: TModule); override;
     function ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; override;
+    function IsOff: Boolean; override;
   end;
 
   { TEndpointModule }
@@ -109,6 +111,8 @@ type
     LowCount, HighCount: Integer;
   end;
 
+  TButtonResults = specialize TList<TButtonResult>;
+
   { TPulsePropagation }
 
   TPulsePropagation = class(TSolver)
@@ -117,7 +121,7 @@ type
     FBroadcaster: TModule;
     procedure UpdateModuleConnections;
     function PushButton: TButtonResult;
-    function CalcCounterTarget(const AFirstFlipFlop: TModule): Int64;
+    function AreAllModulesOff: Boolean;
   public
     constructor Create;
     destructor Destroy; override;
@@ -176,6 +180,11 @@ begin
   FOutputs.Add(AOutput);
 end;
 
+function TModule.IsOff: Boolean;
+begin
+  Result := True;
+end;
+
 { TBroadcasterModule }
 
 function TBroadcasterModule.ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses;
@@ -195,12 +204,17 @@ begin
   end;
 end;
 
+function TFlipFlopModule.IsOff: Boolean;
+begin
+  Result := not FState;
+end;
+
 { TConjunctionModule }
 
 procedure TConjunctionModule.UpdateInputBuffer(constref AInput: TModule; const AState: Boolean);
 var
   i: Integer;
-  buffer: TConjunctionInputBuffer;
+  buffer: TConjectionBuffer;
 begin
   for i := 0 to FInputBuffers.Count - 1 do
     if FInputBuffers[i].Input = AInput then
@@ -212,13 +226,13 @@ begin
     end;
 end;
 
-function TConjunctionModule.AreAllBuffersHigh: Boolean;
+function TConjunctionModule.AreAllBuffersSame(const AIsHigh: Boolean): Boolean;
 var
-  buffer: TConjunctionInputBuffer;
+  buffer: TConjectionBuffer;
 begin
   Result := True;
   for buffer in FInputBuffers do
-    if not buffer.LastState then
+    if buffer.LastState <> AIsHigh then
     begin
       Result := False;
       Exit;
@@ -228,7 +242,7 @@ end;
 constructor TConjunctionModule.Create(const AName: string);
 begin
   inherited Create(AName);
-  FInputBuffers := TConjunctionInputBuffers.Create;
+  FInputBuffers := TConjectionBuffers.Create;
 end;
 
 destructor TConjunctionModule.Destroy;
@@ -239,7 +253,7 @@ end;
 
 procedure TConjunctionModule.AddInput(const AInput: TModule);
 var
-  buffer: TConjunctionInputBuffer;
+  buffer: TConjectionBuffer;
 begin
   buffer.Input := AInput;
   buffer.LastState := False;
@@ -249,7 +263,12 @@ end;
 function TConjunctionModule.ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses;
 begin
   UpdateInputBuffer(ASender, AIsHigh);
-  Result := CreatePulsesToOutputs(not AreAllBuffersHigh);
+  Result := CreatePulsesToOutputs(not AreAllBuffersSame(True));
+end;
+
+function TConjunctionModule.IsOff: Boolean;
+begin
+  Result := AreAllBuffersSame(False);
 end;
 
 { TEndpointModule }
@@ -323,39 +342,17 @@ begin
   queue.Free;
 end;
 
-function TPulsePropagation.CalcCounterTarget(const AFirstFlipFlop: TModule): Int64;
+function TPulsePropagation.AreAllModulesOff: Boolean;
 var
-  binDigit: Int64;
-  current, next: TModule;
-  i: Integer;
+  module: TModule;
 begin
-  Result := 0;
-  binDigit := 1;
-  current := AFirstFlipFlop;
-  while True do
-  begin
-    if current.Outputs.Count = 1 then
+  Result := True;
+  for module in FModules do
+    if not module.IsOff then
     begin
-      current := current.Outputs.First;
-      if current is TConjunctionModule then
-      begin
-        Result := Result + binDigit;
-        Break;
-      end;
-    end
-    else begin
-      Result := Result + binDigit;
-      i := 0;
-      repeat
-        if i = current.Outputs.Count then
-          Exit;
-        next := current.Outputs[i];
-        Inc(i);
-      until next is TFlipFlopModule;
-      current := next;
+      Result := False;
+      Exit;
     end;
-    binDigit := binDigit << 1;
-  end;
 end;
 
 constructor TPulsePropagation.Create;
@@ -395,26 +392,42 @@ end;
 
 procedure TPulsePropagation.Finish;
 var
-  result, accumulated: TButtonResult;
-  i: Integer;
-  module: TModule;
+  results: TButtonResults;
+  finalResult: TButtonResult;
+  cycles, remainder, i, j, max: Integer;
 begin
   UpdateModuleConnections;
 
-  accumulated.LowCount := 0;
-  accumulated.HighCount := 0;
-  for i := 1 to CButtonPushes do
+  // The pulse counts for the full puzzle input repeat themselves in a very specific way, but the system state does not.
+  // This indicates there is a better solution for this problem.
+  // TODO: See if there is a better solution based on the repeating patterns in the pulse counts.
+  results := TButtonResults.Create;
+  repeat
+    results.Add(PushButton);
+  until AreAllModulesOff or (results.Count >= CButtonPushes);
+
+  DivMod(CButtonPushes, results.Count, cycles, remainder);
+  finalResult.LowCount := 0;
+  finalResult.HighCount := 0;
+  max := results.Count - 1;
+  for j := 0 to 1 do
   begin
-    result := PushButton;
-    Inc(accumulated.LowCount, result.LowCount);
-    Inc(accumulated.HighCount, result.HighCount);
+    for i := 0 to max do
+    begin
+      Inc(finalResult.LowCount, results[i].LowCount);
+      Inc(finalResult.HighCount, results[i].HighCount);
+    end;
+    if j = 0 then
+    begin
+      finalResult.LowCount := finalResult.LowCount * cycles;
+      finalResult.HighCount := finalResult.HighCount * cycles;
+      max := remainder - 1;
+    end;
   end;
 
-  FPart1 := accumulated.LowCount * accumulated.HighCount;
+  results.Free;
 
-  FPart2 := 1;
-  for module in FBroadcaster.Outputs do
-    FPart2 := FPart2 * CalcCounterTarget(module);
+  FPart1 := finalResult.LowCount * finalResult.HighCount;
 end;
 
 function TPulsePropagation.GetDataFileName: string;

solvers/UStepCounter.pas

@@ -22,25 +22,23 @@ unit UStepCounter;
 interface
 
 uses
-  Classes, SysUtils, USolver, UCommon;
+  Classes, SysUtils, Generics.Collections, USolver, UCommon;
 
 type
+  TPoints = specialize TList<TPoint>;
 
   { TStepCounter }
 
   TStepCounter = class(TSolver)
   private
     FLines: TStringList;
-    FWidth, FHeight, FMaxSteps1, FMaxSteps2: Integer;
+    FWidth, FHeight, FMaxSteps: Integer;
     function FindStart: TPoint;
     function IsInBounds(constref APoint: TPoint): Boolean;
     function GetPosition(constref APoint: TPoint): Char;
     procedure SetPosition(constref APoint: TPoint; const AValue: Char);
-    procedure PrepareMap;
-    function DoSteps(const AMaxSteps: Integer): Int64;
-    function CalcTargetPlotsOnInfiniteMap(const AMaxSteps: Integer): Int64;
   public
-    constructor Create(const AMaxStepsPart1: Integer = 64; const AMaxStepsPart2: Integer = 26501365);
+    constructor Create(const AMaxSteps: Integer = 64);
     destructor Destroy; override;
     procedure ProcessDataLine(const ALine: string); override;
     procedure Finish; override;
@@ -51,7 +49,6 @@ type
 const
   CStartChar = 'S';
   CPlotChar = '.';
-  CRockChar = '#';
   CTraversedChar = '+';
 
 implementation
@@ -91,37 +88,40 @@ begin
   FLines[APoint.Y] := s;
 end;
 
-procedure TStepCounter.PrepareMap;
-var
-  i, j: Integer;
+constructor TStepCounter.Create(const AMaxSteps: Integer);
 begin
-  for i := 2 to FWidth - 1 do
-    for j := 1 to FHeight - 2 do
-      if (FLines[j][i] <> CRockChar) and (FLines[j - 1][i] = CRockChar) and (FLines[j + 1][i] = CRockChar)
-      and (FLines[j][i - 1] = CRockChar) and (FLines[j][i + 1] = CRockChar) then
-        SetPosition(Point(i, j), CRockChar);
+  FMaxSteps := AMaxSteps;
+  FLines := TStringList.Create;
 end;
 
-function TStepCounter.DoSteps(const AMaxSteps: Integer): Int64;
+destructor TStepCounter.Destroy;
+begin
+  FLines.Free;
+  inherited Destroy;
+end;
+
+procedure TStepCounter.ProcessDataLine(const ALine: string);
+begin
+  FLines.Add(ALine);
+end;
+
+procedure TStepCounter.Finish;
 var
-  mod2, currentStep: Integer;
+  currentStep: Integer;
   currentPlots, nextPlots, temp: TPoints;
   plot, next: TPoint;
   pdirection: PPoint;
 begin
+  FWidth := Length(FLines[0]);
+  FHeight := FLines.Count;
+
   currentStep := 0;
   currentPlots := TPoints.Create;
   currentPlots.Add(FindStart);
+  Inc(FPart1);
   nextPlots := TPoints.Create;
 
-  // Counts the start if max steps is even.
-  mod2 := AMaxSteps and 1;
-  if mod2 = 0 then
-    Result := 1
-  else
-    Result := 0;
-
-  while currentStep < AMaxSteps do
+  while currentStep < FMaxSteps do
   begin
     for plot in currentPlots do
       for pdirection in CPCardinalDirections do
@@ -140,142 +140,15 @@ begin
     nextPlots := temp;
     Inc(currentStep);
 
-    // Positions where the number of steps are even or odd (for even or odd AMaxSteps, respectively) can be reached with
-    // trivial backtracking, so they count.
-    if currentStep and 1 = mod2 then
-      Inc(Result, currentPlots.Count);
+    // Positions where the number of steps are even can be reached with trivial backtracking, so they count.
+    if currentStep mod 2 = 0 then
+      Inc(FPart1, currentPlots.Count);
   end;
 
   currentPlots.Free;
   nextPlots.Free;
 end;
 
-function TStepCounter.CalcTargetPlotsOnInfiniteMap(const AMaxSteps: Integer): Int64;
-var
-  half, k, i, j: Integer;
-  factor1, factor1B, factor2, factor4A: Int64;
-begin
-  Result := 0;
-
-  // Asserts square input map with odd size.
-  if (FWidth <> FHeight) or (FWidth and 1 = 0) then
-    Exit;
-  // Asserts half map size is odd.
-  half := FWidth shr 1;
-  if half and 1 = 0 then
-    Exit;
-  // Asserts that there is an even k such that maximum number of steps is equal to k + 1/2 times the map size.
-  // k is the number of visited repeated maps, not counting the start map, when taking all steps in a straight line in
-  // any of the four directions.
-  k := (AMaxSteps - half) div FWidth;
-  if (k and 1 = 0) and (AMaxSteps <> k * FWidth + half) then
-    Exit;
-
-  // Assuming that the rocks on the map are sparse enough, and the central vertical and horizontal lines are empty,
-  // every free plot with odd (Manhattan) distance (not larger than AMaxSteps) to the start plot (because of trivial
-  // backtracking) on the maps is reachable, essentially formning a 45-degree rotated square shape centered on the start
-  // plot.
-
-  // Inside this "diamond" shape, 2k(k - 1) + 1 (k-th centered square number) copies of the map are traversed fully.
-  // However, there are two different types of these. (k - 1)^2 are traversed like the start map, where all plots with
-  // odd distance to the center are reachable (type 1), and k^2 are traversed such that all plots within odd distance to
-  // the center are reachable (type 2).
-
-  // On each of the corners of this "diamond" shape, there is one map traversed fully except for two adjacent of its
-  // corner triangles (type 3).
-
-  // On each of the edges of this "diamond" shape, there are k maps where only the corner triangle facing towards the
-  // shapes center is traversed (type 4), and k - 1 maps that are fully traversed except for the corner triangle facing
-  // away from the shapes center (type 5).
-
-  // The four different versions of type 4 do not overlap within a map, so they can be counted together (type 4A).
-
-  // Types 1, 3, and 5 share patterns, so they can also be counted together, but the parts of the patterns have
-  // different counts. Each corner (type 1A) is traversed (k - 1)^2 times for type 1, 2 times for type 3, and 3(k - 1)
-  // for type 5, that is (k - 1)^2 + 3k - 1 in total. The center (type 1B) is traversed (k - 1)^2 times for type 1, 4
-  // times for type 3, and 4(k - 1) for type 5, that is (k - 1)^2 + 4k.
-  // Equivalently, instead type 1 is traversed (k - 1)^2 + 3k - 1 times and type 1B is traversed k + 1 times.
-
-  // Types example for k = 2, half = 5:
-  //   4            5            2                      4A
-  //   ...........  .....O.O.O.  O.O.O.O.O.O            O.O.O.O.O.O
-  //   ...........  ....O.O.O.O  .O.O.O.O.O.            .O.O...O.O.
-  //   ...........  ...O.O.O.O.  O.O.O.O.O.O            O.O.....O.O
-  //   ......#....  ..O.O.#.O.O  .O.O.O#O.O.            .O....#..O.
-  //   ...#.......  .O.#.O.O.O.  O.O#O.O.O.O            O..#......O
-  //   ...........  O.O.O.O.O.O  .O.O.O.O.O.            ...........
-  //   ....#..#..O  .O.O#O.#.O.  O.O.#.O.#.O            O...#..#..O
-  //   .........O.  O.O.O.O.O.O  .O.O.O.O.O.            .O.......O.
-  //   ........O.O  .O.O.O.O.O.  O.O.O.O.O.O            O.O.....O.O
-  //   .......O.O.  O.O.O.O.O.O  .O.O.O.O.O.            .O.O...O.O.
-  //   ......O.O.O  .O.O.O.O.O.  O.O.O.O.O.O            O.O.O.O.O.O
-  //
-  //   3            2            1                      1A           1B
-  //   .....O.O.O.  O.O.O.O.O.O  .O.O.O.O.O.            .O.O...O.O.  .....O.....
-  //   ....O.O.O.O  .O.O.O.O.O.  O.O.O.O.O.O            O.O.....O.O  ....O.O....
-  //   ...O.O.O.O.  O.O.O.O.O.O  .O.O.O.O.O.            .O.......O.  ...O.O.O...
-  //   ..O.O.#.O.O  .O.O.O#O.O.  O.O.O.#.O.O            O.....#...O  ..O.O.#.O..
-  //   .O.#.O.O.O.  O.O#O.O.O.O  .O.#.O.O.O.            ...#.......  .O.#.O.O.O.
-  //   O.O.O.O.O.O  .O.O.O.O.O.  O.O.OSO.O.O            ...........  O.O.O.O.O.O
-  //   .O.O#O.#.O.  O.O.#.O.#.O  .O.O#O.#.O.            ....#..#...  .O.O#O.#.O.
-  //   ..O.O.O.O.O  .O.O.O.O.O.  O.O.O.O.O.O            O.........O  ..O.O.O.O..
-  //   ...O.O.O.O.  O.O.O.O.O.O  .O.O.O.O.O.            .O.......O.  ...O.O.O...
-  //   ....O.O.O.O  .O.O.O.O.O.  O.O.O.O.O.O            O.O.....O.O  ....O.O....
-  //   .....O.O.O.  O.O.O.O.O.O  .O.O.O.O.O.            .O.O...O.O.  .....O.....
-
-  // Sets factors, aka number of occurrences, for each type.
-  factor1 := (k - 1) * (k - 1) + 3 * k - 1;
-  factor1B := k + 1;
-  factor2 := k * k;
-  factor4A := k;
-  for i := 0 to FWidth - 1 do
-    for j := 1 to FWidth do
-      if FLines[i][j] <> CRockChar then
-        if (i and 1) = (j and 1) then
-        begin
-          // Counts types 1.
-          Result := Result + factor1;
-          // Counts types 1B.
-          if not ((i + j <= half) or (i + j > FWidth + half) or (i - j >= half) or (j - i > half + 1)) then
-            Result := Result + factor1B;
-        end
-        else begin
-          // Counts types 2.
-          Result := Result + factor2;
-          // Counts types 4A.
-          if (i + j <= half) or (i + j > FWidth + half) or (i - j >= half) or (j - i > half + 1) then
-            Result := Result + factor4A;
-        end
-end;
-
-constructor TStepCounter.Create(const AMaxStepsPart1: Integer; const AMaxStepsPart2: Integer);
-begin
-  FMaxSteps1 := AMaxStepsPart1;
-  FMaxSteps2 := AMaxStepsPart2;
-  FLines := TStringList.Create;
-end;
-
-destructor TStepCounter.Destroy;
-begin
-  FLines.Free;
-  inherited Destroy;
-end;
-
-procedure TStepCounter.ProcessDataLine(const ALine: string);
-begin
-  FLines.Add(ALine);
-end;
-
-procedure TStepCounter.Finish;
-begin
-  FWidth := Length(FLines[0]);
-  FHeight := FLines.Count;
-  PrepareMap;
-
-  FPart2 := CalcTargetPlotsOnInfiniteMap(FMaxSteps2);
-  FPart1 := DoSteps(FMaxSteps1);
-end;
-
 function TStepCounter.GetDataFileName: string;
 begin
   Result := 'step_counter.txt';

tests/AdventOfCodeFPCUnit.lpi

@@ -152,6 +152,10 @@
         <Filename Value="USnowverloadTestCases.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="UBinomialCoefficientsTestCases.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

tests/AdventOfCodeFPCUnit.lpr

@@ -10,7 +10,7 @@ uses
   UFloorWillBeLavaTestCases, UClumsyCrucibleTestCases, ULavaductLagoonTestCases, UAplentyTestCases,
   UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases, ULongWalkTestCases,
   UNeverTellMeTheOddsTestCases, USnowverloadTestCases, UBigIntTestCases, UPolynomialTestCases,
-  UPolynomialRootsTestCases;
+  UPolynomialRootsTestCases, UBinomialCoefficientsTestCases;
 
 {$R *.res}
 

tests/UBinomialCoefficientsTestCases.pas

@@ -0,0 +1,138 @@
+{
+  Solutions to the Advent Of Code.
+  Copyright (C) 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 UBinomialCoefficientsTestCases;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, UBinomialCoefficients;
+
+type
+
+  { TBinomialCoefficientsTestCase }
+
+  TBinomialCoefficientsTestCase = class(TTestCase)
+  private
+    FBinomialCoefficientCache: TBinomialCoefficientCache;
+    procedure RunRangeError;
+    procedure AssertEqualsCalculation(const AN, AK, AExpected: Cardinal);
+    procedure AssertEqualsCachedRowsCount(const AExpected: Cardinal);
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  published
+    procedure TestZeroChooseZero;
+    procedure TestNChooseZero;
+    procedure TestNChooseN;
+    procedure TestNChooseK;
+    procedure TestCombined;
+    procedure TestFullRow;
+    procedure TestRangeError;
+  end;
+
+implementation
+
+{ TBinomialCoefficientsTestCase }
+
+procedure TBinomialCoefficientsTestCase.RunRangeError;
+begin
+  FBinomialCoefficientCache.Get(1, 5);
+end;
+
+procedure TBinomialCoefficientsTestCase.AssertEqualsCalculation(const AN, AK, AExpected: Cardinal);
+begin
+  AssertEquals('Unexpected calculation result', AExpected, FBinomialCoefficientCache.Get(AN, AK));
+end;
+
+procedure TBinomialCoefficientsTestCase.AssertEqualsCachedRowsCount(const AExpected: Cardinal);
+begin
+  AssertEquals('Unexpected cached rows count', AExpected, FBinomialCoefficientCache.GetCachedRowsCount);
+end;
+
+procedure TBinomialCoefficientsTestCase.SetUp;
+begin
+  FBinomialCoefficientCache := TBinomialCoefficientCache.Create;
+end;
+
+procedure TBinomialCoefficientsTestCase.TearDown;
+begin
+  FBinomialCoefficientCache.Free;
+end;
+
+procedure TBinomialCoefficientsTestCase.TestZeroChooseZero;
+begin
+  AssertEqualsCalculation(0, 0, 1);
+  AssertEqualsCachedRowsCount(1);
+end;
+
+procedure TBinomialCoefficientsTestCase.TestNChooseZero;
+begin
+  AssertEqualsCalculation(15, 0, 1);
+  AssertEqualsCachedRowsCount(16);
+end;
+
+procedure TBinomialCoefficientsTestCase.TestNChooseN;
+begin
+  AssertEqualsCalculation(11, 11, 1);
+  AssertEqualsCachedRowsCount(12);
+end;
+
+procedure TBinomialCoefficientsTestCase.TestNChooseK;
+begin
+  AssertEqualsCalculation(8, 3, 56);
+  AssertEqualsCachedRowsCount(9);
+end;
+
+procedure TBinomialCoefficientsTestCase.TestCombined;
+begin
+  AssertEqualsCalculation(5, 1, 5);
+  AssertEqualsCachedRowsCount(6);
+  AssertEqualsCalculation(8, 4, 70);
+  AssertEqualsCachedRowsCount(9);
+  AssertEqualsCalculation(3, 1, 3);
+  AssertEqualsCachedRowsCount(9);
+end;
+
+procedure TBinomialCoefficientsTestCase.TestFullRow;
+begin
+  AssertEqualsCalculation(5, 0, 1);
+  AssertEqualsCachedRowsCount(6);
+  AssertEqualsCalculation(5, 1, 5);
+  AssertEqualsCachedRowsCount(6);
+  AssertEqualsCalculation(5, 2, 10);
+  AssertEqualsCachedRowsCount(6);
+  AssertEqualsCalculation(5, 3, 10);
+  AssertEqualsCachedRowsCount(6);
+  AssertEqualsCalculation(5, 4, 5);
+  AssertEqualsCachedRowsCount(6);
+  AssertEqualsCalculation(5, 5, 1);
+  AssertEqualsCachedRowsCount(6);
+end;
+
+procedure TBinomialCoefficientsTestCase.TestRangeError;
+begin
+  AssertException(ERangeError, @RunRangeError);
+end;
+
+initialization
+
+  RegisterTest('Helper', TBinomialCoefficientsTestCase);
+end.
+

tests/UHotSpringsTestCases.pas

@@ -26,6 +26,16 @@ uses
 
 type
 
+  { THotSpringsFullDataTestCase }
+
+  THotSpringsFullDataTestCase = class(TEngineBaseTest)
+  protected
+    function CreateSolver: ISolver; override;
+  published
+    procedure TestPart1;
+    procedure TestPart2;
+  end;
+
   { THotSpringsExampleTestCase }
 
   THotSpringsExampleTestCase = class(TExampleEngineBaseTest)
@@ -33,6 +43,7 @@ type
     function CreateSolver: ISolver; override;
   published
     procedure TestPart1;
+    procedure TestPart2;
   end;
 
   { THotSpringsTestCase }
@@ -40,18 +51,29 @@ type
   THotSpringsTestCase = class(TSolverTestCase)
   protected
     function CreateSolver: ISolver; override;
-    procedure TestSingleLine(const ALine: string; const AValue: Integer);
+    procedure TestSingleLine(const ALine: string);
   published
-    procedure TestExampleLine1;
-    procedure TestExampleLine2;
-    procedure TestExampleLine3;
-    procedure TestExampleLine4;
-    procedure TestExampleLine5;
-    procedure TestExampleLine6;
+    procedure TestExampleLine1Part1;
+    procedure TestExampleLine2Part1;
+    procedure TestExampleLine3Part1;
+    procedure TestExampleLine4Part1;
+    procedure TestExampleLine5Part1;
+    procedure TestExampleLine6Part1;
+    procedure TestExampleLine1Part2;
+    procedure TestExampleLine2Part2;
+    procedure TestExampleLine3Part2;
+    procedure TestExampleLine4Part2;
+    procedure TestExampleLine5Part2;
+    procedure TestExampleLine6Part2;
   end;
 
 implementation
 
+procedure THotSpringsFullDataTestCase.TestPart2;
+begin
+  AssertEquals(-1, FSolver.GetResultPart2);
+end;
+
 { THotSpringsExampleTestCase }
 
 function THotSpringsExampleTestCase.CreateSolver: ISolver;
@@ -64,6 +86,11 @@ begin
   AssertEquals(21, FSolver.GetResultPart1);
 end;
 
+procedure THotSpringsExampleTestCase.TestPart2;
+begin
+  AssertEquals(525152, FSolver.GetResultPart2);
+end;
+
 { THotSpringsTestCase }
 
 function THotSpringsTestCase.CreateSolver: ISolver;
@@ -71,42 +98,83 @@ begin
   Result := THotSprings.Create;
 end;
 
-procedure THotSpringsTestCase.TestSingleLine(const ALine: string; const AValue: Integer);
+procedure THotSpringsTestCase.TestSingleLine(const ALine: string);
 begin
   FSolver.Init;
   FSolver.ProcessDataLine(ALine);
   FSolver.Finish;
-  AssertEquals(AValue, FSolver.GetResultPart1);
 end;
 
-procedure THotSpringsTestCase.TestExampleLine1;
+procedure THotSpringsTestCase.TestExampleLine1Part1;
 begin
-  TestSingleLine('???.### 1,1,3', 1);
+  TestSingleLine('???.### 1,1,3');
+  AssertEquals(1, FSolver.GetResultPart1);
 end;
 
-procedure THotSpringsTestCase.TestExampleLine2;
+procedure THotSpringsTestCase.TestExampleLine2Part1;
 begin
-  TestSingleLine('.??..??...?##. 1,1,3', 4);
+  TestSingleLine('.??..??...?##. 1,1,3');
+  AssertEquals(4, FSolver.GetResultPart1);
 end;
 
-procedure THotSpringsTestCase.TestExampleLine3;
+procedure THotSpringsTestCase.TestExampleLine3Part1;
 begin
-  TestSingleLine('?#?#?#?#?#?#?#? 1,3,1,6', 1);
+  TestSingleLine('?#?#?#?#?#?#?#? 1,3,1,6');
+  AssertEquals(1, FSolver.GetResultPart1);
 end;
 
-procedure THotSpringsTestCase.TestExampleLine4;
+procedure THotSpringsTestCase.TestExampleLine4Part1;
 begin
-  TestSingleLine('????.#...#... 4,1,1', 1);
+  TestSingleLine('????.#...#... 4,1,1');
+  AssertEquals(1, FSolver.GetResultPart1);
 end;
 
-procedure THotSpringsTestCase.TestExampleLine5;
+procedure THotSpringsTestCase.TestExampleLine5Part1;
 begin
-  TestSingleLine('????.######..#####. 1,6,5', 4);
+  TestSingleLine('????.######..#####. 1,6,5');
+  AssertEquals(4, FSolver.GetResultPart1);
 end;
 
-procedure THotSpringsTestCase.TestExampleLine6;
+procedure THotSpringsTestCase.TestExampleLine6Part1;
 begin
-  TestSingleLine('?###???????? 3,2,1', 10);
+  TestSingleLine('?###???????? 3,2,1');
+  AssertEquals(10, FSolver.GetResultPart1);
+end;
+
+procedure THotSpringsTestCase.TestExampleLine1Part2;
+begin
+  TestSingleLine('???.### 1,1,3');
+  AssertEquals(1, FSolver.GetResultPart2);
+end;
+
+procedure THotSpringsTestCase.TestExampleLine2Part2;
+begin
+  TestSingleLine('.??..??...?##. 1,1,3');
+  AssertEquals(16384, FSolver.GetResultPart2);
+end;
+
+procedure THotSpringsTestCase.TestExampleLine3Part2;
+begin
+  TestSingleLine('?#?#?#?#?#?#?#? 1,3,1,6');
+  AssertEquals(1, FSolver.GetResultPart2);
+end;
+
+procedure THotSpringsTestCase.TestExampleLine4Part2;
+begin
+  TestSingleLine('????.#...#... 4,1,1');
+  AssertEquals(16, FSolver.GetResultPart2);
+end;
+
+procedure THotSpringsTestCase.TestExampleLine5Part2;
+begin
+  TestSingleLine('????.######..#####. 1,6,5');
+  AssertEquals(2500, FSolver.GetResultPart2);
+end;
+
+procedure THotSpringsTestCase.TestExampleLine6Part2;
+begin
+  TestSingleLine('?###???????? 3,2,1');
+  AssertEquals(506250, FSolver.GetResultPart2);
 end;
 
 initialization

tests/ULongWalkTestCases.pas

@@ -1,6 +1,6 @@
 {
   Solutions to the Advent Of Code.
-  Copyright (C) 2023-2024  Stefan Müller
+  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
@@ -33,7 +33,6 @@ type
     function CreateSolver: ISolver; override;
   published
     procedure TestPart1;
-    procedure TestPart2;
   end;
 
 implementation
@@ -50,11 +49,6 @@ begin
   AssertEquals(94, FSolver.GetResultPart1);
 end;
 
-procedure TLongWalkExampleTestCase.TestPart2;
-begin
-  AssertEquals(154, FSolver.GetResultPart2);
-end;
-
 initialization
 
   RegisterTest('TLongWalk', TLongWalkExampleTestCase);

tests/UStepCounterTestCases.pas

@@ -1,6 +1,6 @@
 {
   Solutions to the Advent Of Code.
-  Copyright (C) 2023-2024  Stefan Müller
+  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
@@ -25,22 +25,10 @@ uses
   Classes, SysUtils, fpcunit, testregistry, USolver, UBaseTestCases, UStepCounter;
 
 type
-  // Note that the solver implementation does not work with the examples presented
-  // in the puzzle description for part 2, therefore they are not represented here
-  // as test cases.
 
-  { TStepCounterExampleSteps3TestCase }
+  { TStepCounterMax6ExampleTestCase }
 
-  TStepCounterExampleSteps3TestCase = class(TExampleEngineBaseTest)
-  protected
-    function CreateSolver: ISolver; override;
-  published
-    procedure TestPart1;
-  end;
-
-  { TStepCounterExampleSteps6TestCase }
-
-  TStepCounterExampleSteps6TestCase = class(TExampleEngineBaseTest)
+  TStepCounterMax6ExampleTestCase = class(TExampleEngineBaseTest)
   protected
     function CreateSolver: ISolver; override;
   published
@@ -49,33 +37,20 @@ type
 
 implementation
 
-{ TStepCounterExampleSteps3TestCase }
+{ TStepCounterMax6ExampleTestCase }
 
-function TStepCounterExampleSteps3TestCase.CreateSolver: ISolver;
+function TStepCounterMax6ExampleTestCase.CreateSolver: ISolver;
 begin
-  Result := TStepCounter.Create(3, 3);
+  Result := TStepCounter.Create(6);
 end;
 
-procedure TStepCounterExampleSteps3TestCase.TestPart1;
-begin
-  AssertEquals(6, FSolver.GetResultPart1);
-end;
-
-{ TStepCounterExampleSteps6TestCase }
-
-function TStepCounterExampleSteps6TestCase.CreateSolver: ISolver;
-begin
-  Result := TStepCounter.Create(6, 6);
-end;
-
-procedure TStepCounterExampleSteps6TestCase.TestPart1;
+procedure TStepCounterMax6ExampleTestCase.TestPart1;
 begin
   AssertEquals(16, FSolver.GetResultPart1);
 end;
 
 initialization
 
-  RegisterTest('TStepCounter', TStepCounterExampleSteps3TestCase);
-  RegisterTest('TStepCounter', TStepCounterExampleSteps6TestCase);
+  RegisterTest('TStepCounter', TStepCounterMax6ExampleTestCase);
 end.