Added bisection root finding algorithm with custom upper bound

This commit is contained in:
Stefan Müller 2024-05-24 20:47:52 +02:00
parent 53e3922654
commit baa1f8f31f
2 changed files with 57 additions and 24 deletions

View File

@ -45,6 +45,7 @@ type
function GetIsolatingInterval(const AC, AK, AH: Cardinal; constref ABound: TBigInt): TIsolatingInterval; function GetIsolatingInterval(const AC, AK, AH: Cardinal; constref ABound: TBigInt): TIsolatingInterval;
public public
function Bisect(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; function Bisect(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals;
function Bisect(constref APolynomial: TBigIntPolynomial; constref ABound: TBigInt): TIsolatingIntervals;
end; end;
implementation implementation
@ -85,9 +86,17 @@ begin
Result.B := (AC + AH) * ABound; Result.B := (AC + AH) * ABound;
end; end;
function TRootIsolation.Bisect(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals;
var
bound: TBigInt;
begin
bound := CalcSimpleRootBound(APolynomial);
Result := Bisect(APolynomial, bound);
end;
// This is adapted from // This is adapted from
// https://en.wikipedia.org/wiki/Real-root_isolation#Bisection_method // https://en.wikipedia.org/wiki/Real-root_isolation#Bisection_method
function TRootIsolation.Bisect(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; function TRootIsolation.Bisect(constref APolynomial: TBigIntPolynomial; constref ABound: TBigInt): TIsolatingIntervals;
type type
TWorkItem = record TWorkItem = record
C, K: Cardinal; C, K: Cardinal;
@ -95,7 +104,6 @@ type
end; end;
TWorkStack = specialize TStack<TWorkItem>; TWorkStack = specialize TStack<TWorkItem>;
var var
bound: TBigInt;
item: TWorkItem; item: TWorkItem;
stack: TWorkStack; stack: TWorkStack;
n, v: Integer; n, v: Integer;
@ -104,12 +112,10 @@ begin
Result := TIsolatingIntervals.Create; Result := TIsolatingIntervals.Create;
stack := TWorkStack.Create; stack := TWorkStack.Create;
bound := CalcSimpleRootBound(APolynomial);
n := item.P.Degree; n := item.P.Degree;
item.C := 0; item.C := 0;
item.K := 0; item.K := 0;
item.P := APolynomial.ScaleVariable(bound); item.P := APolynomial.ScaleVariable(ABound);
stack.Push(item); stack.Push(item);
while stack.Count > 0 do while stack.Count > 0 do
@ -120,7 +126,7 @@ begin
// Found an integer root at 0. // Found an integer root at 0.
item.P := item.P.DivideByVariable; item.P := item.P.DivideByVariable;
Dec(n); Dec(n);
Result.Add(GetIsolatingInterval(item.C, item.K, 0, bound)); Result.Add(GetIsolatingInterval(item.C, item.K, 0, ABound));
end; end;
varq := item.P.RevertOrderOfCoefficients.TranslateVariableByOne; varq := item.P.RevertOrderOfCoefficients.TranslateVariableByOne;
@ -128,7 +134,7 @@ begin
if v = 1 then if v = 1 then
begin begin
// Found isolating interval. // Found isolating interval.
Result.Add(GetIsolatingInterval(item.C, item.K, 1, bound)); Result.Add(GetIsolatingInterval(item.C, item.K, 1, ABound));
end end
else if v > 1 then else if v > 1 then
begin begin

View File

@ -29,18 +29,43 @@ type
{ TPolynomialRootsTestCase } { TPolynomialRootsTestCase }
TPolynomialRootsTestCase = class(TTestCase) TPolynomialRootsTestCase = class(TTestCase)
private
procedure AssertBisectResult(constref AIsolatingIntervals: TIsolatingIntervals; constref AExpectedRoots:
array of Cardinal);
protected protected
FRootIsolation: TRootIsolation; FRootIsolation: TRootIsolation;
procedure SetUp; override; procedure SetUp; override;
procedure TearDown; override; procedure TearDown; override;
published published
procedure TestBisectionRootIsolation; procedure TestBisectNoBound;
procedure TestBisectWithBound;
end; end;
implementation implementation
{ TPolynomialRootsTestCase } { TPolynomialRootsTestCase }
procedure TPolynomialRootsTestCase.AssertBisectResult(constref AIsolatingIntervals: TIsolatingIntervals; constref
AExpectedRoots: array of Cardinal);
var
exp: Cardinal;
ri: TIsolatingInterval;
found: Boolean;
begin
AssertEquals('Unexpected number of isolating intervals.', Length(AExpectedRoots), AIsolatingIntervals.Count);
for exp in AExpectedRoots do
begin
found := False;
for ri in AIsolatingIntervals do
if (ri.A <= exp) and (exp <= ri.B) then
begin
found := True;
Break;
end;
AssertTrue('No isolating interval for expected root ' + IntToStr(exp) + ' found.', found);
end;
end;
procedure TPolynomialRootsTestCase.SetUp; procedure TPolynomialRootsTestCase.SetUp;
begin begin
inherited SetUp; inherited SetUp;
@ -53,32 +78,34 @@ begin
inherited TearDown; inherited TearDown;
end; end;
procedure TPolynomialRootsTestCase.TestBisectionRootIsolation; procedure TPolynomialRootsTestCase.TestBisectNoBound;
const const
expRoots: array of Cardinal = (34000, 23017, 5); expRoots: array of Cardinal = (34000, 23017, 5);
var var
exp: Cardinal;
a: TBigIntPolynomial; a: TBigIntPolynomial;
r: TIsolatingIntervals; r: TIsolatingIntervals;
ri: TIsolatingInterval;
found: Boolean;
begin begin
// y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112) // y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112)
// = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000 // = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000
a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]); a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]);
r := FRootIsolation.Bisect(a); r := FRootIsolation.Bisect(a);
AssertEquals(Length(expRoots), r.Count); AssertBisectResult(r, expRoots);
for exp in expRoots do r.Free;
begin end;
found := False;
for ri in r do procedure TPolynomialRootsTestCase.TestBisectWithBound;
if (ri.A <= exp) and (exp <= ri.B) then const
begin expRoots: array of Cardinal = (23017, 5);
found := True; var
Break; a: TBigIntPolynomial;
end; r: TIsolatingIntervals;
AssertTrue('No isolating interval for expected root ' + IntToStr(exp) + ' found.', found); begin
end; // y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112)
// = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000
a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]);
r := FRootIsolation.Bisect(a, TBigInt.One << 15);
AssertBisectResult(r, expRoots);
r.Free;
end; end;
initialization initialization