Библиотеки для работы с длинными числами
Взято с FAQ c www.sources.ru по Делфи
//Сорри за такой дляинный пост - просто не могу дать он-лайн ссылку - FAQ в файле формата .chm
//Сорри за такой дляинный пост - просто не могу дать он-лайн ссылку - FAQ в файле формата .chm
Работа с очень большими числами
Это модуль для работы с очень большими числами без потери точности. Модуль даёт возможность манипулирования с 10000 и более значащими цифрами в числах. В модуле реализованы сложение, вычитание, умножение, деление, возведение в целую степень и факториал. Все функции в качестве аргументов принимают длинные строки и результат выдают тоже в виде строки.
Автор модуля Vit (http://www.delphist.com)
unit UMathServices;
{Автор Vit}
interface
Type TProgress = procedure(Done:real);
{Собственно экспортные функции}
Function ulFact(First:String):string;
Function ulSum(First, Second :string):string;
Function ulSub(First, Second :string):string;
Function ulMPL(First, Second :string):string;
Function ulPower(First, Second :string):string;
function UlDiv(First, Second:String; Precision:integer):String;
{Precision - не истинная точность а количество знаков учитываемых после запятой сверх тех которые значимы.
Все знаки уже существующие в делимом и делителе в любом случае учитываются}
{Call back function for long operations}
var OnProgress: TProgress;
implementation
Uses SysUtils;
type TMathArray=array of integer;
Type TNumber=record
int, frac:TMathArray;
sign:boolean;
end;
var n1, n2:TNumber;
Procedure Str2Number(s:string; var n:TNumber);
var i, j, l:integer;
begin
if s='' then
begin
setlength(n.int , 0);
setlength(n.frac , 0);
exit;
end;
l:=length(s);
if s[1]='-' then
begin
s:=copy(s,2,l);
l:=l-1;
n.sign:=false;
end
else
n.sign:=true;
j:=pos('.', s);
if j>0 then
begin
setlength(n.int , j-1);
for i:=1 to j-1 do n.int[i-1]:=strtoint(s[j-i]);
setlength(n.frac , l-j);
for i:=1 to l-j do n.frac[i-1]:=strtoint(s[l-i+1]);
end
else
begin
setlength(n.int,l);
for i:=1 to l do n.int[i-1]:=strtoint(s[l-i+1]);
setlength(n.frac,0);
end;
end;
Function Num2Array(Var n:TNumber; var a:TMathArray):integer;
var i:integer;
begin
result:=length(n.frac);
setlength(a,length(n.int)+result);
for i:=0 to length(a)-1 do if i<result then a[i]:=n.frac[i] else a[i]:=n.int[i-result];
end;
Procedure MultiplyArray(var a1, a2, a:TMathArray);
var i, j:integer;
b:boolean;
begin
{checking for zero, 1}
for i:=length(a2)-1 downto 0 do
begin
for j:=length(a1)-1 downto 0 do
begin
a[j+i]:=a[j+i]+(a2[i]*a1[j]);
end;
end;
repeat
b:=true;
for i:=0 to length(a)-1 do
if a[i]>9 then
begin
b:=false;
try
a[i+1]:=a[i+1]+1;
except
setlength(a, length(a)+1);
a[i+1]:=a[i+1]+1;
end;
a[i]:=a[i]-10;
end;
until b;
end;
Procedure Array2Num(Var n:TNumber; var a:TMathArray; frac:integer; sign:boolean);
var i:integer;
begin
setlength(n.frac,frac);
setlength(n.int,length(a)-frac);
for i:=0 to length(a)-1 do
begin
if i<frac then n.frac[i]:=a[i] else n.int[i-frac]:=a[i];
end;
n.sign:=sign;
end;
Function Number2Str(var n:TNumber):string;
var i:integer;
s:string;
begin
result:='';
for i:=0 to high(n.int) do result:=inttostr(n.int[i])+result;
if length(n.frac)<>0 then
begin
for i:=0 to high(n.frac) do s:=inttostr(n.frac[i])+s;
result:=result+'.'+s;
end;
while (length(result)>1) and (result[1]='0') do delete(result,1,1);
if pos('.', result)>0 then while (length(result)>1) and (result[length(result)]='0') do delete(result,length(result1);
if not n.sign then result:='-'+result;
setlength(n.int,0);
setlength(n.frac,0);
end;
Procedure DisposeNumber(var n:TNumber);
begin
setlength(n.int,0);
setlength(n.frac,0);
end;
Function ulFact(First:String):string;
var n1, n2:TNumber;
i:integer;
a, a1, a2:TMathArray;
max:integer;
begin
Str2Number('1', n1);
Str2Number('1', n2);
Num2Array(n1, a1);
Num2Array(n2, a2);
max:=strtoint(First);
for i:=1 to strtoint(First) do
begin
if Assigned(OnProgress) then OnProgressi/max)*100);
setlength(a,length(a1)+length(a2)+1);
MultiplyArray(a1, a2, a);
setlength(a1,0);
setlength(a2,0);
a1:=a;
Str2Number(inttostr(i n2);
Num2Array(n2, a2);
end;
Array2Num(n1, a1, 0, true);
result:=Number2Str(n1);
DisposeNumber(n1);
end;
Function ulPower(First, Second :string):string;
var i, j, c:integer;
a, a1, a2:TMathArray;
var n1:TNumber;
max:integer;
begin
j:=strtoint(Second);
if j=0 then
begin
result:='1';
exit;
end
else
if j=1 then
begin
result:=First;
exit;
end;
max:=j-1;
Str2Number(First, n1);
c:=Num2Array(n1, a1);
setlength(a,0);
setlength(a2,0);
a2:=a1;
for i:=1 to j-1 do
begin
if Assigned(OnProgress) then OnProgressi/max)*100);
setlength(a,0);
setlength(a,length(a1)+length(a2)+1);
MultiplyArray(a1, a2, a);
setlength(a2,0);
a2:=a;
end;
setlength(a1,0);
setlength(a2,0);
c:=c*j;
if n1.sign then
Array2Num(n1, a, c, true)
else
if odd(j) then Array2Num(n1, a, c, false) else Array2Num(n1, a, c, true);
setlength(a,0);
result:=Number2Str(n1);
DisposeNumber(n1);
end;
Procedure MultiplyNumbers(var n1, n2 :TNumber);
var i:integer;
a, a1, a2:TMathArray;
begin
i:=Num2Array(n1, a1)+Num2Array(n2, a2);
setlength(a,length(a1)+length(a2)+1);
MultiplyArray(a1, a2, a);
setlength(a1,0);
setlength(a2,0);
Array2Num(n1, a, i, n1.sign=n2.sign);
DisposeNumber(n2);
setlength(a,0);
end;
Function ulMPL(First, Second :string):string;
var n1, n2:TNumber;
begin
Str2Number(First, n1);
Str2Number(Second, n2);
MultiplyNumbers(n1, n2);
result:=Number2Str(n1);
DisposeNumber(n1);
end;
Procedure AlignNumbers(var n1, n2:TNumber);
var i1, i2, i:integer;
begin
i1:=length(n1.int);
i2:=length(n2.int);
if i1>i2 then setlength(n2.int, i1);
if i2>i1 then setlength(n1.int, i2);
i1:=length(n1.frac);
i2:=length(n2.frac);
if i1>i2 then
begin
setlength(n2.frac, i1);
for i:=i1-1 downto 0 do
begin
if i-(i1-i2)>0 then n2.frac[i]:=n2.frac[i-(i1-i2)] else n2.frac[i]:=0;
end;
end;
if i2>i1 then
begin
setlength(n1.frac, i2);
for i:=i2-1 downto 0 do
begin
if i-(i2-i1)>0 then n1.frac[i]:=n1.frac[i-(i2-i1)] else n1.frac[i]:=0;
end;
end;
end;
Function SubInteger(a1,a2:TMathArray):integer;
va
Оставить комментарий
6yrop
Может у кого-нибудь есть? в идеале для Паскаля, но можно и для С.P.S. попросили запостить