AdventOfCode2023/solvers/UPulsePropagation.pas

{
  Solutions to the Advent Of Code.
  Copyright (C) 2023  Stefan Müller

  This program is free software: you can redistribute it and/or modify it under
  the terms of the GNU General Public License as published by the Free Software
  Foundation, either version 3 of the License, or (at your option) any later
  version.

  This program is distributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.

  You should have received a copy of the GNU General Public License along with
  this program.  If not, see <http://www.gnu.org/licenses/>.
}

unit UPulsePropagation;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Generics.Collections, Math, USolver;

type
  TModule = class;
  TModules = specialize TObjectList<TModule>;

  { TPulse }

  TPulse = record
    Sender, Destination: TModule;
    IsHigh: Boolean;
  end;

  TPulses = specialize TList<TPulse>;
  TPulseQueue = specialize TQueue<TPulse>;

  { TModule }

  TModule = class
  private
    FName: string;
    FOutputNames: TStringList;
    FOutputs: TModules;
    function CreatePulsesToOutputs(const AHighPulse: Boolean): TPulses;
  public
    property Name: string read FName;
    property OutputNames: TStringList read FOutputNames;
    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 }

  TBroadcasterModule = class(TModule)
  public
    function ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; override;
  end;

  { TFlipFlopModule }

  TFlipFlopModule = class(TModule)
  private
    FState: Boolean;
  public
    function ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; override;
    function IsOff: Boolean; override;
  end;

  { TConjectionBuffer }

  TConjectionBuffer = record
    Input: TModule;
    LastState: Boolean;
  end;

  TConjectionBuffers = specialize TList<TConjectionBuffer>;

  { TConjunctionModule }

  TConjunctionModule = class(TModule)
  private
    FInputBuffers: TConjectionBuffers;
    procedure UpdateInputBuffer(constref AInput: TModule; const AState: 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 }

  TEndpointModule = class(TModule)
  public
    function ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; override;
  end;

  { TButtonResult }

  TButtonResult = record
    LowCount, HighCount: Integer;
  end;

  TButtonResults = specialize TList<TButtonResult>;

  { TPulsePropagation }

  TPulsePropagation = class(TSolver)
  private
    FModules: TModules;
    FBroadcaster: TModule;
    procedure UpdateModuleConnections;
    function PushButton: TButtonResult;
    function AreAllModulesOff: Boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure ProcessDataLine(const ALine: string); override;
    procedure Finish; override;
    function GetDataFileName: string; override;
    function GetPuzzleName: string; override;
  end;

const
  CBroadcasterName = 'broadcaster';
  CFlipFlopPrefix = '%';
  CConjunctionPrefix = '&';
  CButtonPushes = 1000;

implementation

{ TModule }

function TModule.CreatePulsesToOutputs(const AHighPulse: Boolean): TPulses;
var
  pulse: TPulse;
  output: TModule;
begin
  Result := TPulses.Create;
  pulse.Sender := Self;
  pulse.IsHigh := AHighPulse;
  for output in FOutputs do
  begin
    pulse.Destination := output;
    Result.Add(pulse);
  end;
end;

constructor TModule.Create(const AName: string);
begin
  FName := AName;
  FOutputNames := TStringList.Create;
  FOutputs := TModules.Create(False);
end;

destructor TModule.Destroy;
begin
  FOutputNames.Free;
  FOutputs.Free;
  inherited Destroy;
end;

procedure TModule.AddInput(const AInput: TModule);
begin

end;

procedure TModule.AddOutput(const AOutput: TModule);
begin
  FOutputs.Add(AOutput);
end;

function TModule.IsOff: Boolean;
begin
  Result := True;
end;

{ TBroadcasterModule }

function TBroadcasterModule.ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses;
begin
  Result := CreatePulsesToOutputs(AIsHigh);
end;

{ TFlipFlopModule }

function TFlipFlopModule.ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses;
begin
  if AIsHigh then
    Result := TPulses.Create
  else begin
    FState := not FState;
    Result := CreatePulsesToOutputs(FState);
  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;
begin
  for i := 0 to FInputBuffers.Count - 1 do
    if FInputBuffers[i].Input = AInput then
    begin
      buffer := FInputBuffers[i];
      buffer.LastState := AState;
      FInputBuffers[i] := buffer;
      Exit;
    end;
end;

function TConjunctionModule.AreAllBuffersSame(const AIsHigh: Boolean): Boolean;
var
  buffer: TConjectionBuffer;
begin
  Result := True;
  for buffer in FInputBuffers do
    if buffer.LastState <> AIsHigh then
    begin
      Result := False;
      Exit;
    end;
end;

constructor TConjunctionModule.Create(const AName: string);
begin
  inherited Create(AName);
  FInputBuffers := TConjectionBuffers.Create;
end;

destructor TConjunctionModule.Destroy;
begin
  FInputBuffers.Free;
  inherited Destroy;
end;

procedure TConjunctionModule.AddInput(const AInput: TModule);
var
  buffer: TConjectionBuffer;
begin
  buffer.Input := AInput;
  buffer.LastState := False;
  FInputBuffers.Add(buffer);
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);
end;

{ TEndpointModule }

function TEndpointModule.ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses;
begin
  Result := TPulses.Create;
end;

{ TPulsePropagation }

procedure TPulsePropagation.UpdateModuleConnections;
var
  module, outModule: TModule;
  name: string;
  found: Boolean;
begin
  for module in FModules do
  begin
    for name in module.OutputNames do
    begin
      found := False;
      for outModule in FModules do
        if name = outModule.Name then
        begin
          found := True;
          Break;
        end;

      if not found then
      begin
        outModule := TEndpointModule.Create(name);
        FModules.Add(outModule);
      end;

      module.AddOutput(outModule);
      outModule.AddInput(module);
    end;

    module.OutputNames.Clear;
  end;
end;

function TPulsePropagation.PushButton: TButtonResult;
var
  queue: TPulseQueue;
  pulse: TPulse;
  pulses: TPulses;
begin
  queue := TPulseQueue.Create;
  pulse.Sender := nil;
  pulse.IsHigh := False;
  pulse.Destination := FBroadcaster;
  queue.Enqueue(pulse);
  Result.LowCount := 0;
  Result.HighCount := 0;

  while queue.Count > 0 do
  begin
    pulse := queue.Dequeue;
    if pulse.IsHigh then
      Inc(Result.HighCount)
    else
      Inc(Result.LowCount);
    pulses := pulse.Destination.ReceivePulse(pulse.Sender, pulse.IsHigh);
    for pulse in pulses do
      queue.Enqueue(pulse);
    pulses.Free;
  end;

  queue.Free;
end;

function TPulsePropagation.AreAllModulesOff: Boolean;
var
  module: TModule;
begin
  Result := True;
  for module in FModules do
    if not module.IsOff then
    begin
      Result := False;
      Exit;
    end;
end;

constructor TPulsePropagation.Create;
begin
  FModules := TModules.Create;
end;

destructor TPulsePropagation.Destroy;
begin
  FModules.Free;
  inherited Destroy;
end;

procedure TPulsePropagation.ProcessDataLine(const ALine: string);
var
  split: TStringArray;
  module: TModule;
  i: Integer;
begin
  split := ALine.Split(' ');
  if split[0] = CBroadcasterName then
  begin
    FBroadcaster := TBroadcasterModule.Create(split[0]);
    module := FBroadcaster;
  end
  else if split[0][1] = CFlipFlopPrefix then
    module := TFlipFlopModule.Create(Copy(split[0], 2, Length(split[0]) - 1))
  else if split[0][1] = CConjunctionPrefix then
    module := TConjunctionModule.Create(Copy(split[0], 2, Length(split[0]) - 1));

  for i := 2 to Length(split) - 2 do
    module.OutputNames.Add(Copy(split[i], 1, Length(split[i]) - 1));
  module.OutputNames.Add(split[Length(split) - 1]);

  FModules.Add(module);
end;

procedure TPulsePropagation.Finish;
var
  results: TButtonResults;
  finalResult: TButtonResult;
  cycles, remainder, i, j, max: Integer;
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
  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;
  end;

  results.Free;

  FPart1 := finalResult.LowCount * finalResult.HighCount;
end;

function TPulsePropagation.GetDataFileName: string;
begin
  Result := 'pulse_propagation.txt';
end;

function TPulsePropagation.GetPuzzleName: string;
begin
  Result := 'Day 20: Pulse Propagation';
end;

end.