ubigintsv3.pas

Delphi for fun library v12, latest. This is the library for manuplating list, combination-permutati

Unit UBigIntsV3;

{Copyright 2001-2006, 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.
 }

{$INCLUDE UBigIntsChangeHistory.txt}

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);

    function GetBasePower: integer;
    procedure Trim;
    function GetLength: integer;
    procedure SetDigitLength(const k: integer);
    procedure assignsmall(i2: int64);
    procedure divmodsmall(d:int64; var rem: int64);
    procedure divide2;   {fast divide by 2}

  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 AssignZero;
    procedure AssignOne;

    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 FastMult(const I2: TInteger);
    procedure Divide(const I2: TInteger); overload;
    procedure Divide(const I2: int64); overload;

    procedure Modulo(Const I2:TInteger);   overload;
    procedure Modulo(Const N:Int64); overload;
    procedure ModPow(const I2, m: Tinteger);
    procedure InvMod(I2: Tinteger);

    procedure DivideRem(const I2: TInteger; var remain: TInteger);
    procedure DivideRemTrunc(const I2: TInteger; var remain: TInteger);
    Procedure DivideRemFloor(const I2: TInteger; var remain: TInteger);
    Procedure DivideRemEuclidean(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 ConvertToInt64(var n: int64): boolean;
    function DigitCount: integer;
    procedure SetSign(s: integer);
    function GetSign: integer;
    function IsOdd: boolean;
    function IsPositive: boolean;
    function IsNegative: boolean;
    function IsProbablyPrime: boolean;
    function IsZero: boolean;
    procedure ChangeSign;
    procedure Pow(const exponent: int64);

    procedure Sqroot;
    procedure Square;
    procedure FastSquare;

    procedure Gcd(const I2: Tinteger); overload;
    procedure Gcd(const I2: int64); overload;

    procedure NRoot(const root: integer);
    function GetBase: integer;

  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;
function GetBase:integer;


implementation

uses Math;

var
  ThreadSafe:boolean = false;
  BaseVal:   integer = 1000; {1,000 changed to 100,000 at initialization time}
  BasePower: integer;
  ScratchPads: array of TInteger;
  LastScratchPad: integer;


{************* GetNextScratchPad *************}
function GetNextScratchPad(InitVal: TInteger): TInteger; overload;
{retrieve or create a work variable and initialize it with TInteger value}
var
  L: integer;
begin
  if LastScratchPad > High(ScratchPads) then
  begin
    L := Length(ScratchPads);
    SetLength(ScratchPads, L+1);
    ScratchPads[L] := TInteger.Create;
    Scratchpads[L].Assign(InitVal);
    Result := ScratchPads[L];
  end
  else Result := ScratchPads[LastScratchPad];
  Result.Assign(InitVal);
  Inc(LastScratchPad);
end;


{************* GetNextScratchPad *************}
function GetNextScratchPad(InitVal: Int64): TInteger; overload;
{retrieve or create a work variable and initialize it with int64 value}
var
  L: integer;
begin
  if LastScratchPad > High(ScratchPads) then
  begin
    L := Length(ScratchPads);
    SetLength(ScratchPads, L+1);
    ScratchPads[L] := TInteger.Create;
    scratchpads[L].assign(initval);
    Result := ScratchPads[L];
    Inc(LastScratchPad);
    Exit;
  end;
  Result := ScratchPads[LastScratchPad];
  Result.Assign(InitVal);
  Inc(LastScratchPad);
end;

{*********** GetNextScratchPad *********}
function GetNextScratchPad: TInteger; overload;
{Overload version without initial value, intiaize to 0}
begin
  result:=getnextscratchpad(0);
end;


{************* Release ScratchPad *********}
procedure ReleaseScratchPad(t:TInteger);
begin
  If threadsafe then T.Free
  else
  begin
    Dec(LastScratchPad);
    Assert(T=scratchpads[lastscratchpad],'Scratchpad synch problem ');
    ScratchPads[LastScratchPad].SetDigitLength(1);
  end;
end;

{**************** GetScratchPad ***************}
function GetScratchPad(InitVal: TInteger): TInteger; overload;
{GetScratchPad tests for Threadsafe and, if true,  always creates new since
 scratchpads array could be  shared, if Thredsafe is false ( the default) then
 treat as GetNextScratchPad}
begin
  if ThreadSafe then
  begin
    Result := TInteger.Create;
    result.assign(initval);
  end
  else
    Result := GetNextScratchPad(InitVal);
end;

{**************** GetScratchPad ***************}
function GetScratchPad(InitVal: Int64 = 0): TInteger; overload;
{GetScratchPad tests for Threadsafe and, if true,  always creates new since
 scratchpads array would be  shared, if false treat as GetNextScrattchPad}
begin
  if ThreadSafe then
  begin
    Result := TInteger.Create;
    result.assign(initval);
  end
  else
    Result := GetNextScratchPad(InitVal);
end;

{*************** SetBaseVal *************}
procedure SetBaseVal(const newbase: integer);

  Procedure Setup(var x:TInteger);
  begin
    if assigned(x) then   x.Free;
    x := Tinteger.Create;
  end;

var
  i,n: integer;
begin
  BaseVal := 10;
  BasePower := 1;
  n := newbase;
  {validate new base value}
  if n > 1e6 then  n := trunc(1e6)
  else if n < 10 then  n := 10;
  while n > 10 do
  begin
    Inc(BasePower);
    n := n div 10;
    BaseVal := BaseVal * 10;
  end;
  if lastscratchpad>0
  then Showmessage('Warning - Base value changed,'
         +#13+'all scratchpad variables have been released');
  for i:=0 to high(scratchpads) do scratchpads[i].free;
  setlength(scratchpads,20);
  for i:=0 to 19 do
  begin
    scratchpads[i]:=TInteger.create;
  end;
  lastscratchpad:=0;
end;

{************** GetBasePower **********}
function GetBasePower: integer;
begin
  Result := BasePower;
end;

function GetBase:integer;
begin
  result:=Baseval;
end;


{************* Create ***********}
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 base 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;
*)

(*
{********** 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;
*)




{*************** 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);
var
  iSub3:TInteger;
begin
 (*
  isub3:=GetNextScratchPad(i2);
  isub3.ChangeSign;
  Add(isub3);
  ReleaseScratchPad(isub3);
  *)
  Add(-i2);
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));
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;

{*********** IsNegative ***********}
function TInteger.IsNegative: 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;
  imult1:TInteger;
begin
  xstart := high(self.fDigits);
  //imult1.AssignZero;
  imult1:=GetNextScratchPad(1); {assign 1 just to force sign to +}
  //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);
  releaseScratchPad(imult1);
end;


{********** Trim ***********}
procedure TInteger.Trim;
{eliminate leading zeros}
var
  i, j: integer;
begin
  i := high(fDigits);
  if i >= 0 then
  begin
    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;
  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}
{Loop replaced by Move for speed by Chalres D,  Mar 2006}
var
  len: integer;
begin
  if i2.Base = Base then
  begin
    len := length(i2.fDigits);
    SetLength(fDigits, len);
    move(i2.fdigits[0],fdigits[0], len*sizeof(int64));
    Sign := i2.Sign;
    Trim;
  end
  else
    self.Assign(i2.ConvertToDecimalString(False));
end;

{************ Assign (int64)***********}
procedure TInteger.Assign(const I2: int64);
{Assign - int64}
var
  i:     integer;
  n, nn: int64;
begin
  if system.abs(i2) < Base then
    assignsmall(i2)
  else
  begin
    SetLength(fDigits, 20);
    n := system.abs(i2);
    i := 0;
    repeat
      nn := n div Base;
      fDigits[i] := n - nn * Base;
      n  := nn;
      Inc(i);
    until n = 0;
    if i2 < 0 then
      Sign := -1
    else if i2 = 0 then
      Sign := 0
    else if i2 > 0 then
      Sign := +1;
    SetLength(fDigits, i);
    Trim;
  end;
end;

{************* Assign   (String type *********}
procedure TInteger.Assign(const i2: string);
{Convert a  string number}
var
  i, j:    integer;
  zeroval: boolean;
  n, nn:   int64;
  pos:     integer;
begin
  n := length(I2) div GetBasePower + 1;
  SetLength(fDigits, n);
  for i := 0 to n - 1 do
    fDigits[i] := 0;
  Sign := +1;
  j   := 0;
  zeroval := True;
  n   := 0;
  pos := 1;
  for i := length(i2) downto 1 do
  begin
    if i2[i] in ['0'..'9'] then
    begin
      n   := n + pos * (Ord(i2[i]) - Ord('0'));
      pos := pos * 10;
      if pos > Base then
      begin
        nn  := n div Base;
        fDigits[j] := n - nn * Base;
        n   := nn;
        pos := 10;
        Inc(j);
        zeroval := False;
      end
      else;
    end