|
P.55.1.
unit LargeNumbers;
(*
В данной арифметике каждое число представляется
символьной строкой типа string. Длина строки может
изменяться от 1 до 255.
Самый младший разряд находится в последней позиции строки,
самый старший - в первой или во второй ( если
число отрицательное).
Для отрицательного числа в самой первой позиции
должен идти символ '-'.
Данная арифметика работает только с целыми числами.
Примеры чисел :
0 '0'
1 '1'
-1 '-1'
+999 '999'
-134 '-134'
Признак ошибки хранится в переменной LNErr,
0 - ошибки нет,
>0 - ошибка.
Состояние ошибки может вызвать либо переполнение,
либо деление на нуль, либо извлечение корня из
отрицательного числа.
Все процедуры и функции выполняются только при LNErr=0.
LNErr устанавливается в 0 только один раз при инициализации
модуля
Коды ошибок :
1 - переполнение
2 - деление на 0
3 - извлечение квадратного корня из отрицательного числа
4 - число слишком большое при переводе из символьного
формата в тип integer
*)
interface
var
LNErr : integer;
function LNAdd (var x, y : string) : string;
(* выдает сумму чисел x и y *)
function LNAskSign (var x : string) : integer;
(*
выдает -1 если число x есть отрицательное
выдает 1 если число x есть положительное
*)
Function LNAskZero (var x : string) : boolean;
(*
Если число x есть нуль, то выдает TRUE
иначе - FALSE
*)
Function LNAssign (i : integer) : string;
(*
выдает символьное число равное числу i
*)
procedure LNDivMod( var x, y, z, t : string);
(*
находит частное и остаток от деления двуч чисел.
Если делитель 0, то программа зациклится.
Если делитель положительный, то и остаток положительный
Если делитель отрицательный то и остаток отрицательный
x - делимое
y - делитель
z - частное
t - остаток
*)
function LNInteger ( var x : string) : integer;
(*
переводит число из символьного формата в тип integer
*)
function LNInvert (var x : string) : string;
(*
умножает число x на -1 и выдает результат
*)
function LNMul( var x, y : string) : string;
(*
умножает число x на число y и выдает результат
*)
function LNSub( var x, y : string) : string;
(* выдает разницу чисел x и y *)
implementation
{
function LNAddPositive (var x, y : string) : string;
(*
выдает сумму положительных чисел x и y
*)
Function LNComparePositive (var x, y : string) : boolean;
(*
сравнивает положительное число x с положительным
числом y. Если x>y , то выдает TRUE, иначе - FALSE
*)
procedure LNDivModPositive(var x, y, z, t : string);
(*
исходные данные :
x - делимое
y - делитель
Результат :
z - частное от деления
t - остаток от деления
Процедура работает только с положительными числами
*)
function LNDivPositive( var x : string) : string;
(*
выдает частное от деления положительного числа x на 10
*)
function LNModPositive(var x : string) : integer;
(*
выдает остаток от деления положительного числа x на 10
*)
function LNMulPositiveToDigit( var x : string;
y : integer) : string;
(*
умножает положительное число x на цифру y и выдает результат
*)
function LNMulPositiveToPositive(var x, y : string) : string;
(*
умножает положительное число x на положительное число y и
выдает результат
*)
function LNMulPositiveTo10( var x : string) : string;
(*
умножает положительное число x на 10
*)
Function LNSubPositive (var x,y : string) : string;
(*
вычитает из положительного числа x положительное число y
и выдает результат
*)
procedure LN11DivModPositive( var x, y, z, t : string);
(*
данная процедура работает в предположении, что частное не
может быть больше чем одна цифра
x - делимое
y - делитель
z - частное
t - остаток
*)
}
function LNAddPositive (var x, y : string) : string;
var
z : string;
sum, per, ix, iy : integer;
ax, ay : char;
begin
if LNErr=0 then begin
if not ((length(x)>253) and (length(y)>253))
then begin
z:=''; ix:=length(x);
iy:=length(y); per:=0;
while (ix>0) or (iy>0) do begin
if ix>0 then ax:=x[ix] else ax:='0';
if iy>0 then ay:=y[iy] else ay:='0';
sum:=ord(ax)-ord('0')+ord(ay)-ord('0')+per;
per:=sum div 10;
z:=chr((sum mod 10) + ord('0'))+z;
ix:=ix-1; iy:=iy-1;
end;
if per>0 then z:=chr(per+ord('0'))+z;
LNAddPositive:=z;
end
else LNErr:=1;
end;
end;
Function LNComparePositive (var x, y : string) : boolean;
var
i : integer;
ll, pr : boolean;
begin
if LNErr=0 then begin
if length(x)>length(y) then pr:=true
else
if length(x)
else
begin
ll:=true; i:=1;
while ll and not (i>length(x)-1) do
if x[i]<>y[i] then ll:=false
else i:=i+1;
if ord(x[i])>ord(y[i]) then pr:=true
else pr:=false;
end;
LNComparePositive:=pr;
end;
end;
Function LNSubPositive (var x,y : string) : string;
var
z, m : string;
pr : boolean;
i1, i2, i3, per, i : integer;
begin
if LNErr=0 then begin
if not ((length(x)>253) and (length(y)>253))
then begin
if LNComparePositive(x,y) then begin
pr:=false;
z:=x;
m:=y;
end
else begin
pr:=true;
z:=y;
m:=x;
end;
i1:=length(z); i2:=length(m); per:=0;
while (i1>0) and (i2>0) do begin
if per>0 then begin
if ord(z[i1])>ord('0') then begin
z[i1]:=chr(ord(z[i1])-1);
per:=0;
end
else z[i1]:='9';
end;
if not (ord(z[i1])
z[i1]:=chr(ord(z[i1])-ord(m[i2])+ord('0'))
else begin
per:=1;
z[i1]:=chr(ord(z[i1])+10-ord(m[i2])+ord('0'));
end;
dec(i1); dec(i2);
end;
if per>0 then
if z[i1]<>'0' then z[i1]:=chr(ord(z[i1])-1)
else begin
i3:=i1-1;
while z[i3]='0' do dec(i3);
z[i3]:=chr(ord(z[i3])-1);
for i:=i3+1 to i1 do z[i]:='9';
end;
while (z[1]='0') and (length(z)>1) do z:=Copy(z,2,length(z)-1);
if pr then z:=LNInvert(z);
LNSubPositive:=z;
end
else LNErr:=1;
end;
end;
function LNAdd (var x, y : string) : string;
var
xx, yy, z : string;
ix, iy : integer;
begin
if LNErr=0 then begin
if not ((length(x)>253) and (length(y)>253))
then begin
ix:=LNAskSign(x);
iy:=LNAskSign(y);
if (ix<0) and (iy<0) then begin
xx:=LNInvert(x);
yy:=LNInvert(y);
z:=LNAddPositive(xx,yy);
z:=LNInvert(z);
end
else
if (ix>0) and (iy>0) then
z:=LNAddPositive(x,y)
else
if (ix>0) and (iy<0) then begin
yy:=LNInvert(y);
z:=LNSubPositive(x,yy);
end
else
if (ix<0) and (iy>0) then begin
xx:=LNInvert(x);
z:=LNSubPositive(xx,y);
z:=LNInvert(z);
end;
LNAdd:=z;
end
else LNErr:=1;
end;
end;
function LNAskSign (var x : string) : integer;
var
l : integer;
begin
if LNErr=0 then begin
if x[1]='-' then l:=-1
else l:=1;
LNAskSign:=l;
end;
end;
Function LNAskZero (var x : string) : boolean;
var
d : boolean;
begin
if LNErr=0 then begin
if (x[1]='0') and (length(x)=1) then d:=true
else d:=false;
LNAskZero:=d;
end;
end;
Function LNAssign (i : integer) : string;
var
k, l : integer;
pr : boolean;
s : string;
begin
if LNErr=0 then begin
if i=0 then s:='0'
else begin
k:=i;
if k>0 then pr:=true
else begin
pr:=false;
k:=-k;
end;
s:='';
while k<>0 do begin
l:=k mod 10;
s:=chr(ord('0')+l)+s;
k:=(k-l) div 10;
end;
if not pr then s:='-'+s;
end;
LNAssign:=s;
end;
end;
procedure LN11DivModPositive( var x, y, z, t : string);
var
i : integer;
m : string;
begin
if LNErr=0 then begin
i:=0;
m:=x;
while not LNComparePositive(y,m) do
begin
inc(i);
m:=LNSubPositive(m,y);
end;
t:=m;
z:=LNAssign(i);
end;
end;
procedure LNDivModPositive(var x, y, z, t : string);
var
s, g1, g2, g3, z1, t1 : string;
s1, ii, jj : integer;
begin
if LNErr=0 then begin
if not LNAskZero(y) then begin
s:=LNSubPositive(x,y);
s1:=LNAskSign(s);
if LNAskZero(s) then begin
z:=LNAssign(1);
t:=LNAssign(0);
end
else
if s1=-1 then begin
z:=LNAssign(0);
t:=x;
end
else begin
g1:=Copy(x,1,length(y));
g2:=Copy(x,length(y)+1,length(x)-length(y));
LN11DivModPositive(g1,y,z1,t1);
z:=z1; ii:=length(t1);
while g2<>'' do begin
inc(ii);
g3:=t1+g2;
g1:=Copy(g3,1,ii);
jj:=ii;
while (length(g1)>1) and (g1[1]='0') do begin
g1:=Copy(g1,2,length(g1)-1);
dec(ii);
end;
g2:=Copy(g3,jj+1,length(g3)-jj);
LN11DivModPositive(g1,y,z1,t1);
z:=z+z1;
if z1<>'0' then ii:=length(t1);
end;
if length(z)>1 then
while z[1]='0' do z:=Copy(z,2,length(z)-1);
t:=t1;
end;
end
else LNErr:=2;
end;
end;
procedure LNDivMod( var x, y, z, t : string);
var
xx, yy, ff : string;
begin
if LNErr=0 then begin
if LNAskSign(x)=1 then begin
if LNAskSign(y)=1 then LNDivModPositive(x,y,z,t)
else begin
yy:=LNInvert(y);
LNDivModPositive(x,yy,z,t);
t:=LNInvert(t);
end;
end
else begin
if LNAskSign(y)=1 then begin
xx:=LNInvert(x);
LNDivModPositive(xx,y,z,t);
z:=LNInvert(z);
if not LNAskZero(t) then begin
ff:=LNAssign(1);
z:=LNSub(z,ff);
t:=LNSub(y,t);
end;
end
else begin
xx:=LNInvert(x);
yy:=LNInvert(y);
LNDivModPositive(xx,yy,z,t);
t:=LNInvert(t);
end;
end;
end;
end;
function LNDivPositive( var x : string) : string;
var
y : string;
begin
if LNErr=0 then begin
if length(x)<2 then y:=LNAssign(0)
else
y:=Copy(x,1,length(x)-1);
LNDivPositive:=y;
end;
end;
function LNModPositive(var x : string) : integer;
begin
if LNErr=0 then
LNModPositive:=ord(x[length(x)])-ord('0');
end;
function LNInteger ( var x : string) : integer;
var
aa, y, yy, bb : string;
sign, i, j, s, l, k : integer;
begin
if LNErr=0 then begin
aa:=LNAssign(32767);
if LNAskSign(x)=1 then
begin
y:=x;
sign:=1;
end
else begin
y:=LNInvert(x);
sign:=-1;
end;
bb:=LNSub(aa,y);
if not (LNAskSign(bb)=-1) then begin
i:=length(y); j:=1; s:=0;
for k:=1 to i do begin
l:=LNModPositive(y);
s:=s+l*j;
j:=j*10;
yy:=LNDivPositive(y);
y:=yy;
end;
if sign=-1 then s:=-s;
LNInteger:=s;
end
else LNErr:=4;
end;
end;
function LNInvert (var x : string) : string;
var
y : string;
begin
if LNErr=0 then begin
if not (length(x)>253) then begin
y:=x;
if not LNAskZero(x) then begin
if LNaskSign(x)=1 then y:='-'+x
else y:=Copy(x,2,length(x)-1);
end;
LNInvert:=y;
end
else LNErr:=1;
end;
end;
function LNMulPositiveToDigit( var x : string;
y : integer) : string;
var
z : string;
i, k, per : integer;
begin
if LNErr=0 then begin
if not (length(x)>253) then begin
z:=x; per:=0; i:=length(z);
while i>0 do begin
k:=(ord(z[i])-ord('0'))*y+per;
z[i]:=chr((k mod 10)+ord('0'));
per:=k div 10;
dec(i);
end;
if per>0 then z:=chr(per+ord('0'))+z;
while (z[1]='0') and (length(z)>1) do
z:=Copy(z,2,length(z)-1);
LNMulPositiveToDigit:=z;
end
else LNErr:=1;
end;
end;
function LNMulPositiveTo10( var x : string) : string;
var
y : string;
begin
if LNErr=0 then begin
if not (length(x)>253) then begin
if not LNAskZero(x) then y:=x+'0'
else y:=LNAssign(0);
LNMulPositiveTo10:=y;
end
else LNErr:=1;
end;
end;
function LNMulPositiveToPositive(var x, y : string) : string;
var
c, ib : integer;
a, b, d, e : string;
begin
if LNErr=0 then begin
if not(length(x)+length(y)>253) then begin
if LNComparePositive(x,y) then begin
a:=x;
b:=y;
end
else begin
a:=y;
b:=x;
end;
d:=LNAssign(0); ib:=1;
while not (ib>length(b)) do begin
c:=ord(b[ib])-ord('0');
b:=Copy(b,2,length(b)-1);
d:=LNMulPositiveTo10(d);
e:=LNMulPositiveToDigit(a,c);
d:=LNAdd(d,e);
end;
LNMulPositiveToPositive:=d;
end
else LNErr:=1;
end;
end;
function LNMul( var x, y : string) : string;
var
i : integer;
a, b, c : string;
begin
if LNErr=0 then begin
if not(length(x)+length(y)>253) then begin
i:=LNAskSign(x)*LNAskSign(y);
if LNAskSign(x)=-1 then a:=LNInvert(x) else a:=x;
if LNAskSign(y)=-1 then b:=LNInvert(y) else b:=y;
c:=LNMulPositiveToPositive(a,b);
if i=-1 then c:=LNInvert(c);
LNMul:=c;
end
else LNErr:=1;
end;
end;
function LNSub( var x, y : string) : string;
var
z : string;
begin
if LNErr=0 then begin
if not ((length(x)>253) and (length(y)>253))
then begin
z:=LNInvert(y);
LNSub:=LNAdd(x,z);
end
else LNErr:=1;
end;
end;
begin
LNErr:=0;
end.
|
