ubigintsv2.pas

Delphi的大数运算演示 pudn上大多是VC的 所以传个Delphi的

unit UBigIntsV2;

{Copyright 2005, Gary Darby, Intellitech Systems Inc., www.DelphiForFun.org

 This program may be used or modified for any non-commercial purpose
 so long as this original notice remains in place.
 All other rights are reserved
 }

{ Arbitarily large integer unit -
  Operations supported:
    Assign, Add, Subtract, Multiply, Divide, Modulo, Compare, Factorial
   (Factorial limited to max integer, run time would probably limit it
    to much less)
   All operations are methods of a Tinteger class and replace the value with the
    result.  For binary operations (all except factorial), the second operand is
    passed as a parameter to the procedure.
 }
 {additions by Hans Klein 2005([e-mail])
        Procedures:
          pow(const exponent:Int64);
          square;
          sqroot;
          gcd(i2:tinteger);
          gcd(i2:Int64);
          shiftleft: fast multiplication by base;
          modpow(const e,m:Tinteger);
          invmod(I2:Tinteger);
        Functions:
          shiftright: fast division by base; result=remainder;
          isodd:boolean;
          IsProbablyPrime:boolean;

 {Changes by Charles Doumar September 2005
  Copyright 2005, Charles Doumar
        Rewrites or Additions:
          ConvertToDecimalString(commas:boolean); (total rewrite)
          mult(i2:tinteger) (total rewrite);
          mult(const I2:int64); (total rewrite);
          square (total rewrite);
          Nroot(const root: integer); : find the Nth root of an integer (New)
          abscompare(I2:Int64):integer; (new function)
          GetBase: integer;
          IsZero:boolean;
          CompareZero:integer;
          AssignOne;
          AssignZero;
          ShiftLeftBase10(num: integer);
          ShiftRightBase10(num: integer);
          ShiftLeftNum(num: integer);
          ShiftRightNum(num: integer);
        Optimizations:
          trim - remove condition from loop, check for sign = 0 when val=0
          Assign(Const i2:Int64);  - remove MOD statements
          Assign(const i2:string); - remove MOD statements
          dividerem(const I2:TInteger; var remain:TInteger); - remove MOD statements
          pow(const exponent:Int64);  - remove MOD, call square, remove div
          isodd - remove MOD statement
          absadd - removed MOD statements
          ConvertToDecimalString - removed Mod Statements
          Sqroot; - call new Nroot function
         Bug fixes
          converttoInt64(n: Int64); - fixed overflow problem, fixed sign problem
          invmod - fixed failure to free memory problem
          dividerem - change remainder to 0 when divisor is 0
          fixed various sign functions....

}

{Changes made by Hans Klein Oct 2005, can be found by searching for hk
added
        divide2: handles efficient division by 2.
        divmodsmall(int 64, var int64)
        assignsmall(int 64)
                these two procedures handle integers less than base more efficient;
modified to use these procedures:
        assign(int64)
        modulo(int64)
        modulo(tinteger)
        divide(int64)
        divide(tinteger)
modified and partially rewritten
        modpow
        gcd
optimized:
        isprobablyprime:
          uses divide2
          first factors out small factors using divmodsmall

changed setbaseval(1000) to SetbaseVal(100000);
 changed in procedure setbaseval:
    if n > 10e6 then
    n := trunc(10e6) into
    {if n > 1e6 then
    n := trunc(1e6) as 10e6 produces incorrect results with then root procedures
          }
{Changes made by Charles Doumar Jan 2005

Added:
    AbsoluteValue: make negative number positive
Bug fixes:
    DigitCount: Now correctly counts digits...
    Assign:  Now works with different bases ...
    ShiftLeftBase10: ensure digits Array is set...
    ShiftRightBase10: correctly count digits...
     
optimized:
    Square:  faster
    Mult:  Faster

}
interface

uses Forms, Dialogs, SysUtils, Windows;

type
  TDigits = array of int64;

  TInteger = class(TObject)
  protected

    Sign:    integer;
    fDigits: TDigits;
    Base:    integer;
    procedure AbsAdd(const I2: tinteger);
    function AbsCompare(I2: TInteger): integer; overload;
    function AbsCompare(I2: int64): integer; overload;
    procedure AbsSubtract(const i2: Tinteger);
    procedure AssignZero;
    procedure AssignOne;
    function CompareZero: integer;
    function IsZero: boolean;
    function GetBasePower: integer;
    procedure Trim;
    procedure ShiftLeftBase10(num: integer);
    procedure ShiftRightBase10(num: integer);
    procedure ShiftLeftNum(num: integer);
    procedure ShiftRightNum(num: integer);
  public
    property Digits: TDigits Read fDigits;
    constructor Create;
    procedure Assign(const I2: TInteger); overload;
    procedure Assign(const I2: int64); overload;
    procedure Assign(const I2: string); overload;
    procedure AbsoluteValue;
    procedure Add(const I2: TInteger); overload;
    procedure Add(const I2: int64); overload;
    procedure Subtract(const I2: TInteger); overload;
    procedure Subtract(const I2: int64); overload;
    procedure Mult(const I2: TInteger); overload;
    procedure Mult(const I2: int64); overload;
    procedure Divide(const I2: TInteger); overload;
    procedure Divide(const I2: int64); overload;
    procedure Modulo(const i2: TInteger); overload;
    procedure Modulo(const i2: int64); overload;
    procedure DivideRem(const I2: TInteger; var remain: TInteger);
    function Compare(I2: TInteger): integer; overload;
    function Compare(I2: int64): integer; overload;
    procedure Factorial;
    function ConvertToDecimalString(commas: boolean): string;
    function ConvertToDecimalStringold(commas: boolean): string;
    function ConvertToInt64(var n: int64): boolean;
    function DigitCount: integer;
    procedure SetSign(s: integer);
    function GetSign: integer;
    function IsPositive: boolean;
    procedure ChangeSign;
    procedure Pow(const exponent: int64);
    procedure ModPow(const I2, m: Tinteger);
    procedure Sqroot;
    procedure Square;
    function ShiftRight: integer;
    procedure ShiftLeft;
    procedure Gcd(const I2: Tinteger); overload;
    procedure Gcd(const I2: int64); overload;
    function IsOdd: boolean;
    function IsProbablyPrime: boolean;
    procedure InvMod(I2: Tinteger);
    procedure SetDigitLength(const k: integer);
    function GetLength: integer;
    procedure NRoot(const root: integer);
    function GetBase: integer;
    procedure assignsmall(i2: int64);
    procedure divmodsmall(d: int64; var rem: int64);
    procedure divide2;
  end;

  {Caution - calculations with mixed basevalues are not allowed,
   changes to Baseval should be made before any other TInteger
   operations}
procedure SetBaseVal(const newbase: integer);
function GetBasePower: integer;


implementation

uses Math;

var
  BaseVal:   integer = 1000; {1,000}
  BasePower: integer;
  worki2, imult1, imult2, iadd3, isub3: TInteger;
  idiv2, idiv3, idivd3, idiv4, d, dq: Tinteger;
  icomp3, imod3: TInteger;
  i3, i4:    TInteger;


procedure SetBaseVal(const newbase: integer);
var
  n: integer;
begin
  BaseVal := 10;
  BasePower := 1;
  n := newbase;
  {if n > 10e6 then
    n := trunc(10e6)}
  if n > 1e6 then
    n := trunc(1e6) {validate new base value}
  else if n < 10 then
    n := 10;
  while n > 10 do
  begin
    Inc(BasePower);
    n := n div 10;
    BaseVal := BaseVal * 10;
  end;

  {create, or re-create, work fields}
  if assigned(worki2) then
    worki2.Free;
  worki2 := Tinteger.Create;
  if assigned(imult1) then
    imult1.Free;
  imult1 := Tinteger.Create;
  if assigned(imult2) then
    imult2.Free;
  imult2 := Tinteger.Create;
  if assigned(isub3) then
    isub3.Free;
  isub3 := Tinteger.Create;
  if assigned(iadd3) then
    iadd3.Free;
  iadd3 := Tinteger.Create;
  if assigned(idiv2) then
    idiv2.Free;
  idiv2 := Tinteger.Create;
  if assigned(idiv3) then
    idiv3.Free;
  idiv3 := Tinteger.Create;
  if assigned(idivd3) then
    idivd3.Free;
  idivd3 := Tinteger.Create;
  if assigned(idiv4) then
    idiv4.Free;
  idiv4 := Tinteger.Create;
  if assigned(icomp3) then
    icomp3.Free;
  icomp3 := Tinteger.Create;
  if assigned(imod3) then
    imod3.Free;
  imod3 := Tinteger.Create;
  if assigned(d) then
    d.Free;
  d := Tinteger.Create;
  if assigned(dq) then
    dq.Free;
  dq := Tinteger.Create;
  if assigned(i3) then
    i3.Free;
  i3 := Tinteger.Create;
  if assigned(i4) then
    i4.Free;
  i4 := Tinteger.Create;
end;

function GetBasePower: integer;
begin
  Result := BasePower;
end;

constructor TInteger.Create;
begin
  inherited;
  Base := BaseVal; {base in Tinteger in case we want to handle other bases later}
  AssignZero;
end;

{************ ShiftRight ***********}
function Tinteger.ShiftRight: integer;
  {Divide value by baseval and return the remainder}
var
  c, i: integer;
begin
  Result := fDigits[0];
  c      := high(fDigits);
  for i := 0 to c - 1 do
    fDigits[i] := fDigits[i + 1];
  // do not setlength to zero...
  if c > 0 then
  begin
    SetLength(fDigits, c);
    Trim;
  end
  else
    self.AssignZero;
end;

procedure Tinteger.ShiftRightNum(num: integer);
{Divide value by baseval and return the remainder}
var
  c, i: integer;
begin
  if num > 0 then
  begin
    c := high(fDigits);
    for i := 0 to c - Num do
      fDigits[i] := fDigits[i + Num];
    // do not setlength to zero...
    if c - num + 1 > 0 then
    begin
      SetLength(fDigits, c - num + 1);
      Trim;
    end
    else
      self.AssignZero;
  end;
end;


{********** ShiftLeft *********}
procedure Tinteger.ShiftLeft;
{Multiply value by base}
var
  c, i: integer;
begin
  c := high(fDigits);
  SetLength(fDigits, c + 2);
  for i := c downto 0 do
    fDigits[i + 1] := fDigits[i];
  fDigits[0] := 0;
  Trim;
end;

procedure Tinteger.ShiftLeftNum(num: integer);
{Multiply value by base}
var
  c, i: integer;
begin
  if num > 0 then
  begin
    c := high(fDigits);
    SetLength(fDigits, c + num + 1);
    for i := c downto 0 do
      fDigits[i + num] := fDigits[i];
    for i := num - 1 downto 0 do
      fDigits[i] := 0;
    Trim;
  end;
end;


{*************** SetDigitLength **********}
procedure TInteger.SetDigitLength(const k: integer);
{Expand or contract the number of digits}
begin
  SetLength(fDigits, k);
end;

{*********** GetLength **********}
function TInteger.GetLength: integer;
  {Return the number of digits for this base}
begin
  Result := length(fDigits);
end;

{************** Subtract ************}
procedure Tinteger.Subtract(const I2: TInteger);
{Subtract by negating, adding, and negating again}
begin
  i2.ChangeSign;
  Add(i2);
  i2.ChangeSign;
end;

{************* Subtract (64 bit integer)}
procedure Tinteger.Subtract(const I2: int64);
begin
  isub3.Assign(i2);
  isub3.ChangeSign;
  Add(isub3);
end;

{********* DigitCount ************}
function TInteger.DigitCount: integer;
  { Return count of base 10 digits in the number }
var
  n:   int64;
  Top: integer;
begin
  Top    := high(Digits);
  Result := Top * GetBasePower;
  n      := Digits[Top];
  if n > 0 then
    Result := Result + 1 + system.trunc(Math.Log10(n));
{
  while n > 0 do
  begin
    Inc(Result);
    n := n div 10;
  end;
}
end;

{************* SetSign ************}
procedure TInteger.SetSign(s: integer);
{Set the sign of the number to match the passed integer}
begin
  if s > 0 then
    Sign := +1
  else if s < 0 then
    Sign := -1
  else
    Sign := 0;
end;

{************** GetSign *********}
function TInteger.GetSign: integer;
begin
  Result := Sign;
end;

{*********** IsPositive ***********}
function TInteger.IsPositive: boolean;
begin
  Result := Sign > 0;
end;

{************** ChangeSign **********}
procedure Tinteger.ChangeSign;
begin
  Sign := -Sign;
end;


{******** Square *********}
procedure Tinteger.Square;
  {This square save multiplications, assume high(fdigits)=10, there are 100
   multiplications that must be preformed.  Of these 10 are unique diagonals,
   of the remaining 90 (100-10), 45 are repeated.  This procedure save
   (N*(N-1))/2 multiplications, (e.g., 45 of 100 multiplies).}
const
  ConstShift = 48;
var
  Carry, n, product: int64;
  xstart, i, j, k:   integer;
begin
  xstart := high(self.fDigits);
  imult1.AssignZero;
  imult1.Sign := Sign * Sign;
  SetLength(imult1.fDigits, xstart + xstart + 3);
  // Step 1 - calculate diagonal
  for i := 0 to xstart do
  begin
    k     := i * 2;
    product := fDigits[i] * fDigits[i];
    Carry := product shr ConstShift;
    if Carry = 0 then
      imult1.fDigits[k] := product
    else
    begin
      Carry := product div Base;
      imult1.fDigits[k] := product - Carry * Base;
      imult1.fDigits[k + 1] := Carry;
    end;
  end;
  // Step 2 - calculate repeating part
  for i := 0 to xstart do
  begin
    Carry := 0;
    for j := i + 1 to xstart do
    begin
      k     := i + j;
      product := fDigits[j] * fDigits[i] * 2 + imult1.fDigits[k] + Carry;
      Carry := product shr ConstShift;
      if Carry = 0 then
        imult1.fDigits[k] := product
      else
      begin
        Carry := product div Base;
        imult1.fDigits[k] := product - Carry * Base;
      end;
    end;
    k := xstart + i + 1;
    imult1.fDigits[k] := Carry + imult1.fDigits[k];
  end;
  // Step 3 - place in proper base
  xstart := high(imult1.fDigits);
  Carry  := 0;
  for i := 0 to xstart - 1 do
  begin
    n     := imult1.fDigits[i] + Carry;
    Carry := n div Base;
    imult1.fDigits[i] := n - Carry * Base;
  end;
  imult1.fDigits[xstart] := Carry;
  Assign(imult1);
  //  Trim;  {trim in assign}
end;


{********** Trim ***********}
procedure TInteger.Trim;
{eliminate leading zeros}
var
  i, j: integer;
begin
  i := high(fDigits);
  if i >= 0 then
  begin
    // start add by Charles Doumar
    j := i;
    if (fDigits[0] <> 0) then
      while (fDigits[i] = 0) do
        Dec(i)
    else
      while (i > 0) and (fDigits[i] = 0) do
        Dec(i);
    if j <> i then
      SetLength(fDigits, i + 1);
    // make sure sign is zero if value = 0...
    if (i = 0) and (self.Digits[0] = 0) then
      Sign := 0;
  end
  else
  begin
    AssignZero;
    //    showmessage('error in length of fdigits');
  end;
end;

{**************** GetBasePower *******}
function TInteger.GetBasePower: integer;
var
  n: integer;
begin
  if Base = BaseVal then
    Result := BasePower
  else
  begin
    Result := 0;
    n      := Base;
    while n > 1 do
    begin
      Inc(BasePower);
      n := n div 10;
    end;
  end;
end;

{************* Assign **********}
procedure TInteger.Assign(const I2: TInteger);
{Assign - TInteger}
var
  i: integer;
begin
  if i2.Base = Base then
  begin
    SetLength(fDigits, length(i2.fDigits));
    for i := low(i2.fDigits) to high(i2.fDigits) do
      fDigits[i] := i2.fDigits[i];
    Sign := i2.Sign;
    Trim;
  end
  else
  begin
    //    ShowMessage('Bases conversions not yet supported');
    self.Assign(i2.ConvertToDecimalString(False));
  end;
end;

{************ Assign (int64)***********}
procedure TInteger.Assign(const I2: int64);
{Assign - int64}
var
  i:     integer;
  n, nn: int64;
begin
  // start add by hk.
  if system.abs(i2) < Base then
    assignsmall(i2)
  else
    //endadd
  begin