Длинная арифметика (массивы)
ВрЕМеЧк0 д0бРеНьк0е, comp,
Здесь типы данных и основные процедуры(функции)
const Nmax=10000;
Osn=1000;
type mas=array[0..Nmax]of integer;
var Operand1:mas;
procedure InitOperand(var A:mas;s:string);
var j,i:integer;
begin
A[0]:=1;
for j:=1 to length(s) do
begin
for i:=A[0] downto 1 do
begin
A[i+1]:=A[i+1]+(longint(A[i])*10) div Osn;
A[i]:=(longint(A[i])*10) mod Osn;
end;
A[1]:=A[1]+(ord(s[j])-ord('0'));
if A[A[0]+1]>0 then inc(A[0]);
end;
end;
procedure PrintOperand(A:mas;var st:string);
var s,ls:string;
i:integer;
begin
ls:=inttostr(Osn div 10);
st:=inttostr(A[A[0]]);
for i:=A[0]-1 downto 1 do
begin
s:=inttostr(A[i]);
while length(s)<length(ls) do s:='0'+s;
st:=st+s;
end;
end;
procedure AddOperands(A,B:mas;var C:mas); {сложение}
var i,k:integer;
begin
FillChar(C,SizeOf(C),0);
if A[0]>B[0] then k:=A[0]
else k:=B[0];
for i:=1 to k do
begin
C[i+1]:=longint(C[i]+B[i]+A[i]) div Osn;
C[i]:=longint(C[i]+B[i]+A[i]) mod Osn;
end;
if C[k+1]=0 then C[0]:=k
else C[0]:=k+1;
end;
procedure SubOperands(A,B:mas;var C:mas); {вычитание}
var i,j,Sp:integer;
begin
Sp:=0;
for i:=1 to B[0] do
begin
dec(A[i+Sp],B[i]);
j:=i;
while (j<=A[0])and(A[j+Sp]<0) do
begin
inc(A[j+Sp],Osn);
dec(A[j+Sp+1]);
inc(j);
end;
end;
i:=A[0];
while (i>1)and(A[i]=0) do dec(i);
A[0]:=i;
for i:=0 to A[0] do C[i]:=A[i];
end;
procedure MulOperands(A,B:mas;var C:mas);{умножение}
var i,j:integer;
dv:longint;
begin
FillChar(C,sizeof(C),0);
for i:=1 to A[0] do
for j:=1 to B[0] do
begin
dv:=longint(A[i]*B[j]+C[i+j-1]);
inc(C[i+j],dv div Osn);
C[i+j-1]:=dv mod Osn;
end;
C[0]:=A[0]+B[0];
While (C[0]>1) and (C[C[0]]=0) do dec (C[0]);
end;
function MoreOperand(A,B:mas;sdvig:integer):byte;{сравнение, 0=(A>B),
1=(A<B), 2=(A=B) с учётом сдвига}
var i:integer;
begin
if A[0]>(B[0]+sdvig) then MoreOperand:=0
else if A[0]<(B[0]+sdvig) then MoreOperand:=1
else
begin
i:=A[0];
while (i>sdvig) and (A[i]=B[i-sdvig]) do dec(i);
if i=sdvig then
begin
MoreOperand:=0;
for i:=1 to sdvig do
if A[i]>0 then exit;
MoreOperand:=2;
end
else MoreOperand:=byte(A[i]<B[i-sdvig]);
end;
end;
procedure Sub(var A:mas;B:mas;Sp:integer);(вычитание с учётом сдвига)
var i,j:integer;
begin
for i:=1 to B[0] do
begin
dec(A[i+Sp],B[i]);
j:=i;
while (j<=A[0])and(A[j+Sp]<0) do
begin
inc(A[j+Sp],Osn);
dec(A[j+Sp+1]);
inc(j);
end;
end;
i:=A[0];
while (i>1)and(A[i]=0) do dec(i);
A[0]:=i;
end;
procedure Mul(A:mas;K:longint;var C:mas); (умножение длинного на
короткое)
var i:integer;
begin
FillChar(C,sizeof(C),0);
if k=0 then inc(C[0])
else
begin
for i:=1 to A[0] do
begin
C[i+1]:=(longint(A[i])*K+C[i]) div Osn;
C[i]:=(longint(A[i])*K+C[i]) mod Osn;
end;
if C[A[0]+1]>0 then C[0]:=A[0]+1
else C[0]:=A[0];
end;
end;
function FindBin(var D:mas;const B:mas;Sp:integer):longint;
var down,up:word;
E:mas;
begin
down:=0; up:=osn;
while up-1>down do
begin
mul(B,(up+down) div 2,E);
case MoreOperand(D,E,Sp) of
0: down:=(down+up) div 2;
1: up:=(up+down) div 2;
2: begin up:=(up+down) div 2; down:=up; end;
end;
end;
mul(B,(up+down) div 2,E);
if MoreOperand(D,E,0)=0 then sub(D,E,Sp)
else
begin
sub(E,D,Sp);
D:=E;
end;
FindBin:=(up+down) div 2;
end;
procedure MakeDel(A,B:mas;var C,D:mas); {деление с-целая часть,
d-остаток}
var Sp:integer;
begin
D:=A; Sp:=A[0]-B[0];
if MoreOperand(A,B,Sp)=1 then dec(Sp);
C[0]:=Sp+1;
while Sp>=0 do
begin
C[Sp+1]:=FindBin(D,B,Sp);
dec(Sp);
end;
end;
procedure DivOperands(A,B:mas;var C:mas); (DIV)
var D:mas;
begin
fillchar(C,sizeof(C),0);
C[0]:=1;
fillchar(D,sizeof(D),0);
D[0]:=1;
case MoreOperand(A,B,0) of
0: MakeDel(A,B,C,D);
1: D:=A;
2: C[1]:=1;
end;
end;
procedure ModOperands(A,B:mas;var D:mas); {MOD}
var C:mas;
begin
fillchar(C,sizeof(C),0);
C[0]:=1;
fillchar(D,sizeof(D),0);
D[0]:=1;
case MoreOperand(A,B,0) of
0: MakeDel(A,B,C,D);
1: D:=A;
2: C[1]:=1;
end;
end;
скажем СПАСИБО Окулову С.М. за отличные лекции. :)
