{*******************************************************} { } { VLI - Very long integers } { } { Copyright (c) 2002 Ing.-Buero Lang } { } { Version vom 17.03.2003 } { } {*******************************************************} unit VLI; {$IFOPT Q+} {$DEFINE OverflowCheckOn} {$ENDIF} interface uses Windows, Messages, SysUtils, Classes, Math; const { Integer -2147483648 .. 2147483647 signed 32-bit -2^31 .. 2^31 - 1 999,999,999 = 10^9 - 1 < 2.147 * 10^9 } Base = 1000000000; // Length Base - 1 BaseLen = 9; type // Dynamic array to hold as many as needed integers (< Base) TIntAr = array of Integer; TVLI = class(TPersistent) private { private } // FIntAr represents the integer // FIntAr[0] + FIntAr[1] * Base + FIntAr[2] * Base^2 + .. FIntAr: TIntAr; // FMinus holds the (negative) sign FMinus: Boolean; function GetAsString: string; procedure SetAsString(IntStr: string); function GetAsInteger: Integer; procedure SetAsInteger(const Value: Integer); function GetAsFloat: Extended; procedure SetAsFloat(Value: Extended); function GetAsInt64: Int64; procedure SetAsInt64(const Value: Int64); function GetLenVLI: Integer; procedure SetLenVLI(const Value: Integer); function CalcLenVLI(Digits: Integer): Integer; procedure Adjust; procedure Clean; property FLenVLI: Integer read GetLenVLI write SetLenVLI; protected { protected } public { public } constructor Create; overload; constructor Create(IntStr: string); overload; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure Clear; function Equal(const Right: TVLI): Boolean; procedure Add(const Right: TVLI); overload; procedure Add(const Left, Right: TVLI); overload; function Compare(const Right: TVLI): Integer; overload; function Compare(const Left, Right: TVLI): Integer; overload; function CompareAbs(const Left, Right: TVLI): Integer; procedure Multiply(const Right: TVLI); overload; procedure Multiply(const Left, Right: TVLI); overload; procedure Subtract(const Right: TVLI); overload; procedure Subtract(const Left, Right: TVLI); overload; property AsInteger: Integer read GetAsInteger write SetAsInteger; property AsInt64: Int64 read GetAsInt64 write SetAsInt64; property AsFloat: Extended read GetAsFloat write SetAsFloat; property AsString: string read GetAsString write SetAsString; published { published } end; implementation function PadL(S: string; C: Char; L: Integer): string; var tmp: string; begin Result := S; if Length(S) < L then begin SetLength(tmp, L - Length(S)); FillChar(tmp[1], L - Length(S), C); Result := tmp + Result; end; end; { TVLI } constructor TVLI.Create; begin inherited Create; Clear; end; constructor TVLI.Create(IntStr: string); begin inherited Create; SetAsString(IntStr); end; destructor TVLI.Destroy; begin FLenVLI := 0; inherited; end; // to calculate the size of FIntAr function TVLI.CalcLenVLI(Digits: Integer): Integer; begin Result := (Digits - 1) div BaseLen + 1; end; procedure TVLI.Assign(Source: TPersistent); var I: Integer; begin if (Source <> nil) and (Source is TVLI) then begin FMinus := (Source as TVLI).FMinus; FLenVLI := (Source as TVLI).FLenVLI; for I := 0 to FLenVLI - 1 do FIntAr[I] := (Source as TVLI).FIntAr[I]; end else inherited; end; // to remove leading 'Zero-parts' procedure TVLI.Adjust; var I: Integer; NewLen: Integer; begin NewLen := 1; for I := FLenVLI - 1 downto 0 do begin if FIntAr[I] <> 0 then begin NewLen := I + 1; Break; end; end; FLenVLI := NewLen; end; // to set the array parts to 0 procedure TVLI.Clean; var I: Integer; begin for I := 0 to FLenVLI - 1 do FIntAr[I] := 0; end; // to set the VLI to 0 procedure TVLI.Clear; begin FLenVLI := 1; FMinus := False; FIntAr[0] := 0; end; function TVLI.Equal(const Right: TVLI): Boolean; var I: Integer; begin Result := (FLenVLI = Right.FLenVLI) and (FMinus = Right.FMinus); if Result then begin for I := 0 to FLenVLI - 1 do begin Result := FIntAr[I] = Right.FIntAr[I]; if not Result then Break; end; end; end; {$Q+} function TVLI.GetAsFloat: Extended; var I: Integer; begin // to large VLIs should raise an EOverFlow Result := 0; for I := FLenVLI - 1 downto 0 do begin Result := Result * Base + FIntAr[I]; end; if FMinus then Result := -Result; end; function TVLI.GetAsInt64: Int64; begin // to large VLIs should raise an EIntOverFlow Result := Round(AsFloat); end; function TVLI.GetAsInteger: Integer; begin // to large VLIs should raise an EIntOverFlow Result := Round(AsFloat); end; {$IFNDEF OverflowCheckOn} {$Q-} {$ENDIF} function TVLI.GetAsString: string; var I: Integer; begin if FLenVLI <> 0 then begin Result := ''; for I := FLenVLI - 1 downto 0 do begin if I = FLenVLI - 1 then Result := Result + IntToStr(FIntAr[I]) else Result := Result + PadL(IntToStr(FIntAr[I]), '0', BaseLen); end; if (Result <> '0') and FMinus then Result := '-' + Result; end else begin Result := '0'; end; end; function TVLI.GetLenVLI: Integer; begin Result := Length(FIntAr); end; procedure TVLI.SetAsFloat(Value: Extended); var Digits: Integer; I: Integer; begin FMinus := Sign(Value) = -1; if Abs(Value) >= 1 then Digits := Ceil(Log10(Value)) else Digits := 1; FLenVLI := CalcLenVLI(Digits); for I := 0 to FLenVLI - 1 do begin FIntAr[I] := Round(Frac(Value / Base) * Base); Value := Int(Value / Base); end; end; procedure TVLI.SetAsInt64(const Value: Int64); begin AsString := IntToStr(Value); end; procedure TVLI.SetAsInteger(const Value: Integer); begin AsString := IntToStr(Value); end; procedure TVLI.SetAsString(IntStr: string); var I: Integer; begin FMinus := False; IntStr := Trim(IntStr); if Length(IntStr) <> 0 then begin if IntStr[1] in ['+', '-'] then begin if IntStr[1] = '-' then begin FMinus := True; Delete(IntStr, 1, 1); end; end; FLenVLI := CalcLenVLI(Length(IntStr)); IntStr := PadL(IntStr, '0', FLenVLI * BaseLen); try for I := 0 to FLenVLI - 1 do begin FIntAr[I] := StrToInt(Copy(IntStr, (FLenVLI - I) * BaseLen - (BaseLen - 1), BaseLen)); end; except // EConvertError - IntStr contains characters other than '0' .. '9' on EConvertError do begin Clear; end; end; end else begin Clear; end; end; procedure TVLI.SetLenVLI(const Value: Integer); var OldLength, I: Integer; begin OldLength := Length(FIntAr); if Value > OldLength then begin SetLength(FIntAr, Value); for I := OldLength to Value - 1 do FIntAr[I] := 0; end else if Value < OldLength then begin SetLength(FIntAr, Value); end; end; procedure TVLI.Add(const Right: TVLI); var Result: TVLI; begin Result := TVLI.Create; try Result.Add(Self, Right); Assign(Result); finally Result.Free; end; end; procedure TVLI.Add(const Left, Right: TVLI); procedure AddAB(const A, B: TVLI); var I: Integer; Part: Int64; L1: Integer; CY: Integer; begin CY := 0; L1 := Min(A.FLenVLI, B.FLenVLI); for I := 0 to FLenVLI - 2 do begin if I < L1 then Part := A.FIntAr[I] + B.FIntAr[I] + CY else Part := A.FIntAr[I] + CY; if Part >= Base then begin FIntAr[I] := Part - Base; CY := 1; end else begin FIntAr[I] := Part; CY := 0; end; end; FIntAr[FLenVLI - 1] := CY; Adjust; end; begin // signs ? if Left.FMinus xor Right.FMinus then begin // in case of different signs we perform a subtraction if Left.FMinus then begin // we should hold the original sign Left.FMinus := False; try Subtract(Right, Left); finally // don't forget Left.FMinus := True; end; end else begin Right.FMinus := False; try Subtract(Left, Right); finally Right.FMinus := True; end; end; Exit; end; // the length of the result is Max(length of Left, length of Right) + 1 // maybe the result is one too large - look at the end of the // procedure FLenVLI := Max(Left.FLenVLI, Right.FLenVLI) + 1; // set all parts of the result to 0 Clean; // set the sign of the result (Left.Minus and Right.Minus are equal) FMinus := Left.FMinus; if Left.FLenVLI - Right.FLenVLI > 0 then AddAB(Left, Right) else AddAB(Right, Left); end; procedure TVLI.Multiply(const Right: TVLI); var Result: TVLI; begin Result := TVLI.Create; try Result.Multiply(Self, Right); Assign(Result); finally Result.Free; end; end; procedure TVLI.Multiply(const Left, Right: TVLI); var I, J, K: Integer; PartRes: Int64; begin // the length of the result is length of Left + length of Right // maybe the result is one too large - look at the end of the // procedure FLenVLI := Left.FLenVLI + Right.FLenVLI; // set all parts of the result to 0 Clean; // set the sign of the result FMinus := Left.FMinus xor Right.FMinus; // iterate over all parts of factor 1 for I := 0 to Left.FLenVLI - 1 do begin // in case a part of factor 1 is 0 the following calculation is not necessary if Left.FIntAr[I] = 0 then Continue; // iterate over all parts of factor 2 for J := 0 to Right.FLenVLI - 1 do begin // in case a part of factor 2 is 0 the calculation is also not necessary if Right.FIntAr[J] = 0 then Continue; // multiply the parts // (force Int64 tp prevent integer overflow) PartRes := Int64(Left.FIntAr[I]) * Right.FIntAr[J]; // add the product of the parts to the result, pay attention to the carry for K := I + J to FLenVLI - 1 do begin PartRes := PartRes + FIntAr[K]; FIntAr[K] := PartRes mod Base; PartRes := PartRes div Base; if (PartRes = 0) then Break; end; end; end; // remove leading '0' Adjust; end; function TVLI.Compare(const Right: TVLI): Integer; begin Result := Compare(Self, Right); end; function TVLI.Compare(const Left, Right: TVLI): Integer; var sLeft, sRight: string; begin if Left.FMinus xor Right.FMinus then begin if Left.FMinus then Result := -1 else Result := 1; end else begin sLeft := Left.AsString; sRight := Right.AsString; if Left.FMinus then begin Delete(sLeft, 1, 1); Delete(sRight, 1, 1); end; sLeft := PadL(sLeft, '0', Max(Length(sLeft), Length(sRight))); sRight := PadL(sRight, '0', Length(sLeft)); Result := CompareStr(sLeft, sRight); if Left.FMinus then begin Result := Result * -1; end; // we want only the results -1, 0, 1 Result := Sign(Result); end; end; function TVLI.CompareAbs(const Left, Right: TVLI): Integer; var OldLeftMinus: Boolean; OldRightMinus: Boolean; begin OldLeftMinus := Left.FMinus; OldRightMinus := Right.FMinus; try Left.FMinus := False; Right.FMinus := False; Result := Compare(Left, Right); finally // don't forget Left.FMinus := OldLeftMinus; Right.FMinus := OldRightMinus; end; end; procedure TVLI.Subtract(const Right: TVLI); var Result: TVLI; begin Result := TVLI.Create; try Result.Subtract(Self, Right); Assign(Result); finally Result.Free; end; end; procedure TVLI.Subtract(const Left, Right: TVLI); procedure SubtractAB(const A, B: TVLI); var Part: Int64; I, L1, Borrow: Integer; begin // we have to use both A and B until L1 - 1 L1 := Min(A.FLenVLI, B.FLenVLI); Borrow := 0; for I := 0 to FLenVLI - 1 do begin if I < L1 then Part := A.FIntAr[I] - B.FIntAr[I] - Borrow else Part := A.FIntAr[I] - Borrow; if Part < 0 then begin FIntAr[I] := Part + Base; // to borrow from the next digit Borrow := 1; end else begin FIntAr[I] := Part; Borrow := 0; end; end; Adjust; end; begin // signs ? if Left.FMinus xor Right.FMinus then begin // in case of different signs we perform an addition Right.FMinus := not Right.FMinus; try Add(Left, Right); finally Right.FMinus := not Right.FMinus; end; Exit; end; FLenVLI := Max(Left.FLenVLI, Right.FLenVLI); Clean; case CompareAbs(Left, Right) of -1: begin SubtractAB(Right, Left); FMinus := not Left.FMinus; end; 0: Clear; 1: begin SubtractAB(Left, Right); FMinus := Left.FMinus; end; end; end; end.