Fixed typos in readme

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 part2.
+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.
 
 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,6 +166,24 @@ 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)
@@ -176,6 +194,14 @@ 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)

UCommon.pas

@@ -22,7 +22,7 @@ unit UCommon;
 interface
 
 uses
-  Classes, SysUtils;
+  Classes, SysUtils, Generics.Collections;
 
 type
   PPoint = ^TPoint;
@@ -39,6 +39,10 @@ const
   CDirectionLeftUp: TPoint = (X: -1; Y: -1);
   CPCardinalDirections: array[0..3] of PPoint = (@CDirectionRight, @CDirectionDown, @CDirectionLeft, @CDirectionUp);
 
+type
+  TIntegerList = specialize TList<Integer>;
+  TPoints = specialize TList<TPoint>;
+
 implementation
 
 end.

solvers/UCosmicExpansion.pas

@@ -22,7 +22,7 @@ unit UCosmicExpansion;
 interface
 
 uses
-  Classes, SysUtils, Generics.Collections, Math, USolver;
+  Classes, SysUtils, Generics.Collections, Math, USolver, UCommon;
 
 const
   CGalaxyChar = '#';
@@ -36,8 +36,8 @@ type
   TCosmicExpansion = class(TSolver)
   private
     FExpansionFactor: Integer;
-    FColumnExpansion, FRowExpansion: specialize TList<Integer>;
-    FGalaxies: specialize TList<TPoint>;
+    FColumnExpansion, FRowExpansion: TIntegerList;
+    FGalaxies: TPoints;
     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 := specialize TList<Integer>.Create;
-  FRowExpansion := specialize TList<Integer>.Create;
-  FGalaxies := specialize TList<TPoint>.Create;
+  FColumnExpansion := TIntegerList.Create;
+  FRowExpansion := TIntegerList.Create;
+  FGalaxies := TPoints.Create;
 end;
 
 destructor TCosmicExpansion.Destroy;

solvers/ULongWalk.pas

@@ -25,20 +25,23 @@ uses
   Classes, SysUtils, Generics.Collections, USolver, UCommon;
 
 type
-  TPoints = specialize TList<TPoint>;
-
   TCrossing = class;
 
+  TPathSelectionState = (pssNone, pssIncluded, pssExcluded);
+
   { TPath }
 
   TPath = class
   private
-    FEnd: TCrossing;
+    FStart, FEnd: TCrossing;
     FLength: Integer;
+    FSelected: TPathSelectionState;
   public
+    property StartCrossing: TCrossing read FStart;
     property EndCrossing: TCrossing read FEnd;
     property Length: Integer read FLength;
-    constructor Create(const ALength: Integer; const AEnd: TCrossing);
+    property Selected: TPathSelectionState read FSelected write FSelected;
+    constructor Create(const ALength: Integer; const AStart, AEnd: TCrossing);
   end;
 
   TPaths = specialize TObjectList<TPath>;
@@ -57,20 +60,51 @@ type
   TCrossing = class
   private
     FPosition: TPoint;
-    FOutPaths: TPaths;
+    FOutPaths, FPaths: 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)
@@ -78,12 +112,15 @@ type
     FLines: TStringList;
     FPaths: TPaths;
     FCrossings, FWaitingForOtherInPath: TCrossings;
-    FStart: TCrossing;
+    FPathLengthSum: Int64;
     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;
@@ -103,30 +140,163 @@ implementation
 
 { TPath }
 
-constructor TPath.Create(const ALength: Integer; const AEnd: TCrossing);
+constructor TPath.Create(const ALength: Integer; const AStart, 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 }
@@ -138,17 +308,17 @@ end;
 
 procedure TLongWalk.ProcessPaths;
 var
-  stack: TPathStartQueue;
+  queue: TPathStartQueue;
   pathStart: TPathStart;
 begin
-  stack := TPathStartQueue.Create;
-  pathStart.Position := FStart.Position;
-  pathStart.Crossing := FStart;
+  queue := TPathStartQueue.Create;
+  pathStart.Crossing := FCrossings.First;
+  pathStart.Position := FCrossings.First.Position;
   pathStart.ReverseDirection := CDirectionUp;
-  stack.Enqueue(pathStart);
-  while stack.Count > 0 do
-    StepPath(stack);
-  stack.Free;
+  queue.Enqueue(pathStart);
+  while queue.Count > 0 do
+    StepPath(queue);
+  queue.Free;
 end;
 
 procedure TLongWalk.StepPath(const AStartPositionQueue: TPathStartQueue);
@@ -163,8 +333,8 @@ var
   path: TPath;
 begin
   start := AStartPositionQueue.Dequeue;
-  len := 1;
-  if start.Crossing <> FStart then
+  len := 0;
+  if start.Crossing <> FCrossings.First then
     Inc(len);
   oneMore := False;
   stop := False;
@@ -192,9 +362,11 @@ begin
   until stop;
 
   crossing := FindOrCreateCrossing(start.Position, AStartPositionQueue);
-  path := TPath.Create(len, crossing);
+  path := TPath.Create(len, start.Crossing, crossing);
+  FPathLengthSum := FPathLengthSum + path.FLength;
   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
@@ -257,6 +429,8 @@ 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;
@@ -266,17 +440,82 @@ begin
   begin
     for path in crossing.OutPaths do
       if path.EndCrossing.Distance < crossing.Distance + path.Length then
-        path.EndCrossing.Distance := crossing.Distance + path.Length;
+        path.EndCrossing.Distance := crossing.Distance + path.Length + 1;
   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;
@@ -291,10 +530,7 @@ end;
 procedure TLongWalk.ProcessDataLine(const ALine: string);
 begin
   if FLines.Count = 0 then
-  begin
-    FStart := TCrossing.Create(Point(ALine.IndexOf(CPathChar) + 1, 0));
-    FCrossings.Add(FStart);
-  end;
+    FCrossings.Add(TCrossing.Create(Point(ALine.IndexOf(CPathChar) + 1, 0)));
   FLines.Add(ALine);
 end;
 
@@ -302,6 +538,7 @@ 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  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
@@ -22,7 +22,7 @@ unit UPulsePropagation;
 interface
 
 uses
-  Classes, SysUtils, Generics.Collections, Math, USolver;
+  Classes, SysUtils, Generics.Collections, 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,31 +71,29 @@ type
     FState: Boolean;
   public
     function ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; override;
-    function IsOff: Boolean; override;
   end;
 
-  { TConjectionBuffer }
+  { TConjunctionInputBuffer }
 
-  TConjectionBuffer = record
+  TConjunctionInputBuffer = record
     Input: TModule;
     LastState: Boolean;
   end;
 
-  TConjectionBuffers = specialize TList<TConjectionBuffer>;
+  TConjunctionInputBuffers = specialize TList<TConjunctionInputBuffer>;
 
   { TConjunctionModule }
 
   TConjunctionModule = class(TModule)
   private
-    FInputBuffers: TConjectionBuffers;
+    FInputBuffers: TConjunctionInputBuffers;
     procedure UpdateInputBuffer(constref AInput: TModule; const AState: Boolean);
-    function AreAllBuffersSame(const AIsHigh: Boolean): Boolean;
+    function AreAllBuffersHigh: 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 }
@@ -111,8 +109,6 @@ type
     LowCount, HighCount: Integer;
   end;
 
-  TButtonResults = specialize TList<TButtonResult>;
-
   { TPulsePropagation }
 
   TPulsePropagation = class(TSolver)
@@ -121,7 +117,7 @@ type
     FBroadcaster: TModule;
     procedure UpdateModuleConnections;
     function PushButton: TButtonResult;
-    function AreAllModulesOff: Boolean;
+    function CalcCounterTarget(const AFirstFlipFlop: TModule): Int64;
   public
     constructor Create;
     destructor Destroy; override;
@@ -180,11 +176,6 @@ begin
   FOutputs.Add(AOutput);
 end;
 
-function TModule.IsOff: Boolean;
-begin
-  Result := True;
-end;
-
 { TBroadcasterModule }
 
 function TBroadcasterModule.ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses;
@@ -204,17 +195,12 @@ 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: TConjectionBuffer;
+  buffer: TConjunctionInputBuffer;
 begin
   for i := 0 to FInputBuffers.Count - 1 do
     if FInputBuffers[i].Input = AInput then
@@ -226,13 +212,13 @@ begin
     end;
 end;
 
-function TConjunctionModule.AreAllBuffersSame(const AIsHigh: Boolean): Boolean;
+function TConjunctionModule.AreAllBuffersHigh: Boolean;
 var
-  buffer: TConjectionBuffer;
+  buffer: TConjunctionInputBuffer;
 begin
   Result := True;
   for buffer in FInputBuffers do
-    if buffer.LastState <> AIsHigh then
+    if not buffer.LastState then
     begin
       Result := False;
       Exit;
@@ -242,7 +228,7 @@ end;
 constructor TConjunctionModule.Create(const AName: string);
 begin
   inherited Create(AName);
-  FInputBuffers := TConjectionBuffers.Create;
+  FInputBuffers := TConjunctionInputBuffers.Create;
 end;
 
 destructor TConjunctionModule.Destroy;
@@ -253,7 +239,7 @@ end;
 
 procedure TConjunctionModule.AddInput(const AInput: TModule);
 var
-  buffer: TConjectionBuffer;
+  buffer: TConjunctionInputBuffer;
 begin
   buffer.Input := AInput;
   buffer.LastState := False;
@@ -263,12 +249,7 @@ end;
 function TConjunctionModule.ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses;
 begin
   UpdateInputBuffer(ASender, AIsHigh);
-  Result := CreatePulsesToOutputs(not AreAllBuffersSame(True));
-end;
-
-function TConjunctionModule.IsOff: Boolean;
-begin
-  Result := AreAllBuffersSame(False);
+  Result := CreatePulsesToOutputs(not AreAllBuffersHigh);
 end;
 
 { TEndpointModule }
@@ -342,17 +323,39 @@ begin
   queue.Free;
 end;
 
-function TPulsePropagation.AreAllModulesOff: Boolean;
+function TPulsePropagation.CalcCounterTarget(const AFirstFlipFlop: TModule): Int64;
 var
-  module: TModule;
+  binDigit: Int64;
+  current, next: TModule;
+  i: Integer;
 begin
-  Result := True;
-  for module in FModules do
-    if not module.IsOff then
+  Result := 0;
+  binDigit := 1;
+  current := AFirstFlipFlop;
+  while True do
+  begin
+    if current.Outputs.Count = 1 then
     begin
-      Result := False;
-      Exit;
+      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;
     end;
+    binDigit := binDigit << 1;
+  end;
 end;
 
 constructor TPulsePropagation.Create;
@@ -392,42 +395,26 @@ end;
 
 procedure TPulsePropagation.Finish;
 var
-  results: TButtonResults;
-  finalResult: TButtonResult;
-  cycles, remainder, i, j, max: Integer;
+  result, accumulated: TButtonResult;
+  i: Integer;
+  module: TModule;
 begin
   UpdateModuleConnections;
 
-  // 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
+  accumulated.LowCount := 0;
+  accumulated.HighCount := 0;
+  for i := 1 to CButtonPushes do
   begin
-    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;
+    result := PushButton;
+    Inc(accumulated.LowCount, result.LowCount);
+    Inc(accumulated.HighCount, result.HighCount);
   end;
 
-  results.Free;
+  FPart1 := accumulated.LowCount * accumulated.HighCount;
 
-  FPart1 := finalResult.LowCount * finalResult.HighCount;
+  FPart2 := 1;
+  for module in FBroadcaster.Outputs do
+    FPart2 := FPart2 * CalcCounterTarget(module);
 end;
 
 function TPulsePropagation.GetDataFileName: string;

solvers/UStepCounter.pas

@@ -22,23 +22,25 @@ unit UStepCounter;
 interface
 
 uses
-  Classes, SysUtils, Generics.Collections, USolver, UCommon;
+  Classes, SysUtils, USolver, UCommon;
 
 type
-  TPoints = specialize TList<TPoint>;
 
   { TStepCounter }
 
   TStepCounter = class(TSolver)
   private
     FLines: TStringList;
-    FWidth, FHeight, FMaxSteps: Integer;
+    FWidth, FHeight, FMaxSteps1, FMaxSteps2: 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 AMaxSteps: Integer = 64);
+    constructor Create(const AMaxStepsPart1: Integer = 64; const AMaxStepsPart2: Integer = 26501365);
     destructor Destroy; override;
     procedure ProcessDataLine(const ALine: string); override;
     procedure Finish; override;
@@ -49,6 +51,7 @@ type
 const
   CStartChar = 'S';
   CPlotChar = '.';
+  CRockChar = '#';
   CTraversedChar = '+';
 
 implementation
@@ -88,40 +91,37 @@ begin
   FLines[APoint.Y] := s;
 end;
 
-constructor TStepCounter.Create(const AMaxSteps: Integer);
-begin
-  FMaxSteps := AMaxSteps;
-  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;
+procedure TStepCounter.PrepareMap;
 var
-  currentStep: Integer;
+  i, j: 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);
+end;
+
+function TStepCounter.DoSteps(const AMaxSteps: Integer): Int64;
+var
+  mod2, 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;
 
-  while currentStep < FMaxSteps do
+  // 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
   begin
     for plot in currentPlots do
       for pdirection in CPCardinalDirections do
@@ -140,15 +140,142 @@ begin
     nextPlots := temp;
     Inc(currentStep);
 
-    // 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);
+    // 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);
   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/ULongWalkTestCases.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
@@ -33,6 +33,7 @@ type
     function CreateSolver: ISolver; override;
   published
     procedure TestPart1;
+    procedure TestPart2;
   end;
 
 implementation
@@ -49,6 +50,11 @@ 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  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
@@ -25,10 +25,22 @@ 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.
 
-  { TStepCounterMax6ExampleTestCase }
+  { TStepCounterExampleSteps3TestCase }
 
-  TStepCounterMax6ExampleTestCase = class(TExampleEngineBaseTest)
+  TStepCounterExampleSteps3TestCase = class(TExampleEngineBaseTest)
+  protected
+    function CreateSolver: ISolver; override;
+  published
+    procedure TestPart1;
+  end;
+
+  { TStepCounterExampleSteps6TestCase }
+
+  TStepCounterExampleSteps6TestCase = class(TExampleEngineBaseTest)
   protected
     function CreateSolver: ISolver; override;
   published
@@ -37,20 +49,33 @@ type
 
 implementation
 
-{ TStepCounterMax6ExampleTestCase }
+{ TStepCounterExampleSteps3TestCase }
 
-function TStepCounterMax6ExampleTestCase.CreateSolver: ISolver;
+function TStepCounterExampleSteps3TestCase.CreateSolver: ISolver;
 begin
-  Result := TStepCounter.Create(6);
+  Result := TStepCounter.Create(3, 3);
 end;
 
-procedure TStepCounterMax6ExampleTestCase.TestPart1;
+procedure TStepCounterExampleSteps3TestCase.TestPart1;
+begin
+  AssertEquals(6, FSolver.GetResultPart1);
+end;
+
+{ TStepCounterExampleSteps6TestCase }
+
+function TStepCounterExampleSteps6TestCase.CreateSolver: ISolver;
+begin
+  Result := TStepCounter.Create(6, 6);
+end;
+
+procedure TStepCounterExampleSteps6TestCase.TestPart1;
 begin
   AssertEquals(16, FSolver.GetResultPart1);
 end;
 
 initialization
 
-  RegisterTest('TStepCounter', TStepCounterMax6ExampleTestCase);
+  RegisterTest('TStepCounter', TStepCounterExampleSteps3TestCase);
+  RegisterTest('TStepCounter', TStepCounterExampleSteps6TestCase);
 end.