AdventOfCode2023/UPolynomialRoots.pas

{
  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 UPolynomialRoots;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Generics.Collections, UPolynomial, UBigInt;

type

  { TIsolatingInterval }

  // Represents an isolating interval of the form [C / 2^K, (C + H) / 2^K] in respect to [0, 1] or [A, B] in respect to
  // [0, bound], with A = C * bound / 2^K and B = (C + H) * bound / 2^K.
  TIsolatingInterval = record
    C, K, H: Cardinal;
    Bound, A, B: TBigInt;
  end;

  TIsolatingIntervals = specialize TList<TIsolatingInterval>;

  { TPolynomialRoots }

  TPolynomialRoots = class
  private
    class function CalcUpperRootBound(constref APolynomial: TBigIntPolynomial): TBigInt;
    class function CreateIsolatingInterval(const AC, AK, AH: Cardinal; constref ABound: TBigInt): TIsolatingInterval;
  public
    class function BisectIsolation(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals;
    class function BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABound: TBigInt):
      TIsolatingIntervals;
  end;

implementation

{ TPolynomialRoots }

class function TPolynomialRoots.CalcUpperRootBound(constref APolynomial: TBigIntPolynomial): TBigInt;
var
  i, sign: Integer;
  an, ai, max: TBigInt;
  numeratorBit, denominatorBit: Int64;
begin
  // We need a_n > 0 here, so we use -sign(a_n) instead of actually flipping the polynomial.
  // Sign is not 0 because a_n is not 0.
  an := APolynomial.Coefficient[APolynomial.Degree];
  sign := -an.Sign;

  // This is a simplification of Cauchy's bound to avoid division and make it a power of two.
  // https://en.wikipedia.org/wiki/Geometrical_properties_of_polynomial_roots#Bounds_of_positive_real_roots
  max := TBigInt.Zero;
  for i := 0 to APolynomial.Degree - 1 do begin
    ai := sign * APolynomial.Coefficient[i];
    if max < ai then
      max := ai;
  end;
  numeratorBit := max.GetMostSignificantBitIndex + 1;
  denominatorBit := an.GetMostSignificantBitIndex;
  Result := TBigInt.One << (numeratorBit - denominatorBit);
end;

class function TPolynomialRoots.CreateIsolatingInterval(const AC, AK, AH: Cardinal; constref ABound: TBigInt):
  TIsolatingInterval;
begin
  Result.C := AC;
  Result.K := AK;
  Result.H := AH;
  Result.Bound := ABound;
  Result.A := (AC * ABound) >> AK;
  Result.B := ((AC + AH) * ABound) >> AK;
end;

class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals;
var
  bound: TBigInt;
begin
  bound := CalcUpperRootBound(APolynomial);
  Result := BisectIsolation(APolynomial, bound);
end;

// This is adapted from
// https://en.wikipedia.org/wiki/Real-root_isolation#Bisection_method
class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABound: TBigInt):
  TIsolatingIntervals;
type
  TWorkItem = record
    C, K: Cardinal;
    P: TBigIntPolynomial;
  end;
  TWorkStack = specialize TStack<TWorkItem>;
var
  item: TWorkItem;
  stack: TWorkStack;
  n, v: Integer;
  varq: TBigIntPolynomial;
begin
  Result := TIsolatingIntervals.Create;
  stack := TWorkStack.Create;

  item.C := 0;
  item.K := 0;
  item.P := APolynomial.ScaleVariable(ABound);
  stack.Push(item);
  n := item.P.Degree;

  while stack.Count > 0 do
  begin
    item := stack.Pop;
    if item.P.Coefficient[0] = TBigInt.Zero then
    begin
      // Found an integer root at 0.
      item.P := item.P.DivideByVariable;
      Dec(n);
      Result.Add(CreateIsolatingInterval(item.C, item.K, 0, ABound));
    end;

    varq := item.P.RevertOrderOfCoefficients.TranslateVariableByOne;
    v := varq.CalcSignVariations;
    if v = 1 then
    begin
      // Found isolating interval.
      Result.Add(CreateIsolatingInterval(item.C, item.K, 1, ABound));
    end
    else if v > 1 then
    begin
      // Bisects, first new work item is (2c, k + 1, 2^n * q(x/2)).
      item.C := item.C << 1;
      Inc(item.K);
      item.P := item.P.ScaleVariableByHalf.ScaleByPowerOfTwo(n);
      stack.Push(item);
      // ... second new work item is (2c + 1, k + 1, 2^n * q((x+1)/2)).
      item.C := item.C + 1;
      item.P := item.P.TranslateVariableByOne;
      stack.Push(item);
    end;
  end;
  stack.Free;
end;

end.