Код
Unit Dlinn;
Interface
const
n=100;
type
tnom=1..n;
tc=0..19;
mas=array[tnom] of tc;
smas=^mas;
num=record
ch:smas;
k:0..n;
sgn:boolean;
end;
procedure newch(var a:num);
procedure readch(var f:text; var a:num);
procedure writech(var f:text; const a:num);
function max (const a,b:integer):integer;
procedure sum (var a,b:num; var c:num);
function more(const a,b:num):boolean;
procedure vich (var a,b:num; var c:num);
procedure umn (const a,b:num; var c:num);
procedure beautify(var a:num);
Implementation
procedure newch(var a:num);
begin
new(a.ch);
a.k:=0;
a.sgn:=true;
end;
{_______________________________________}
procedure readch(var f:text; var a:num);
var i:tnom; c:char;
begin
newch(a);
i:=1;
while not seekeoln(f) do
begin
read(f,c);
case c of
'+':a.sgn:=true;
'-':a.sgn:=false;
else
begin
a.ch^[i]:=ord(c)-ord('0');
inc(a.k);
inc(i);
end;
end;
end;
readln(f);
end;
{________________________________________}
procedure writech(var f:text; const a:num);
var i:tnom;
begin
if not a.sgn then write(f,'-');
for i:=1 to a.k do
write(f,a.ch^[i]);
writeln(f);
writeln(f,'***********')
end;
{________________________________________}
function max (const a,b:integer):integer;
begin
if a>b then max:=a
else max:=b;
end;
{________________________________________}
procedure sum (var a,b:num; var c:num);
var s,ost:integer;
i:tnom;
begin
newch(c);
c.k:=max(a.k,b.k);
ost:=0;
if a.k<b.k then
begin
for i:=a.k downto 1 do a.ch^[i+b.k-a.k]:=a.ch^[i];
for i:=1 to b.k-a.k do a.ch^[i]:=0;
a.k:=b.k;
end;
if a.k>b.k then
begin
for i:=b.k downto 1 do b.ch^[i+a.k-b.k]:=b.ch^[i];
for i:=1 to a.k-b.k do b.ch^[i]:=0;
b.k:=a.k;
end;
for i:=max(a.k,b.k) downto 1 do
begin
c.ch^[i]:=(ost+a.ch^[i]+b.ch^[i]) mod 10;
ost:=(ost+a.ch^[i]+b.ch^[i]) div 10
end;
if ost>0 then
begin
for i:=c.k downto 1 do c.ch^[i+1]:=c.ch^[i];
inc(c.k);
c.ch^[1]:=ost;
end;
end;
{_______________________________________}
function more(const a,b:num):boolean;
var i:integer;
begin
i:=1;
while (a.k>=i)and(b.k>=i)and(a.ch^[i]=b.ch^[i]) do inc(i);
more:=(a.ch^[i]>b.ch^[i])and(a.k>=b.k);
end;
{_______________________________________}
procedure vich (var a,b:num; var c:num);
var ost:integer;
i,l,j:tnom;
ob:boolean;
help:smas;
res:mas;
begin
newch(c);
if more(b,a) then
begin
c.sgn:=false;
l:=b.k;
b.k:=a.k;
a.k:=l;
ob:=a.sgn;
a.sgn:=b.sgn;
b.sgn:=ob;
help:=a.ch;
a.ch:=b.ch;
b.ch:=help;
end;
c.k:=a.k;
res:=a.ch^;
if b.k<a.k then
begin
l:=a.k-b.k;
for i:=b.k downto 1 do
b.ch^[i+l]:=b.ch^[i];
for i:=1 to l do
b.ch^[i]:=0;
b.k:=a.k;
end;
for i:=c.k downto 1 do
begin
if a.ch^[i]<b.ch^[i] then
begin
l:=i-1;
while a.ch^[l]=0 do dec(l);
dec(a.ch^[l]);
for j:=l+1 to i-1 do a.ch^[j]:=a.ch^[j]+9;
c.ch^[i]:=a.ch^[i]-b.ch^[i]+10;
end
else c.ch^[i]:=a.ch^[i]-b.ch^[i];
end;
a.ch^:=res;
end;
{______________________________________}
procedure umn (const a,b:num; var c:num);
var i,j:integer;
begin
newch(c);
if a.k+b.k-1>n then
writeln('The structure is too large.Enlarge digit number.Have a nice day!')
else
begin
c.k:=a.k+b.k-1;
for i:=1 to c.k do c.ch^[i]:=0;
for i:=a.k downto 1 do
for j:=b.k downto 1 do
begin
c.ch^[i+j-1]:=c.ch^[i+j-1]+(a.ch^[i]*b.ch^[j]) mod 10;
c.ch^[i+j]:=c.ch^[i+j]+(a.ch^[i]*b.ch^[j]) div 10;
end;
end;
end;
{_____________________________________}
procedure beautify(var a:num);
var i:tnom;
begin
while (a.ch^[1]=0)and(i<a.k) do
begin
for i:=1 to a.k do
a.ch^[i]:=a.ch^[i+1];
dec(a.k);
end;
end;
Interface
const
n=100;
type
tnom=1..n;
tc=0..19;
mas=array[tnom] of tc;
smas=^mas;
num=record
ch:smas;
k:0..n;
sgn:boolean;
end;
procedure newch(var a:num);
procedure readch(var f:text; var a:num);
procedure writech(var f:text; const a:num);
function max (const a,b:integer):integer;
procedure sum (var a,b:num; var c:num);
function more(const a,b:num):boolean;
procedure vich (var a,b:num; var c:num);
procedure umn (const a,b:num; var c:num);
procedure beautify(var a:num);
Implementation
procedure newch(var a:num);
begin
new(a.ch);
a.k:=0;
a.sgn:=true;
end;
{_______________________________________}
procedure readch(var f:text; var a:num);
var i:tnom; c:char;
begin
newch(a);
i:=1;
while not seekeoln(f) do
begin
read(f,c);
case c of
'+':a.sgn:=true;
'-':a.sgn:=false;
else
begin
a.ch^[i]:=ord(c)-ord('0');
inc(a.k);
inc(i);
end;
end;
end;
readln(f);
end;
{________________________________________}
procedure writech(var f:text; const a:num);
var i:tnom;
begin
if not a.sgn then write(f,'-');
for i:=1 to a.k do
write(f,a.ch^[i]);
writeln(f);
writeln(f,'***********')
end;
{________________________________________}
function max (const a,b:integer):integer;
begin
if a>b then max:=a
else max:=b;
end;
{________________________________________}
procedure sum (var a,b:num; var c:num);
var s,ost:integer;
i:tnom;
begin
newch(c);
c.k:=max(a.k,b.k);
ost:=0;
if a.k<b.k then
begin
for i:=a.k downto 1 do a.ch^[i+b.k-a.k]:=a.ch^[i];
for i:=1 to b.k-a.k do a.ch^[i]:=0;
a.k:=b.k;
end;
if a.k>b.k then
begin
for i:=b.k downto 1 do b.ch^[i+a.k-b.k]:=b.ch^[i];
for i:=1 to a.k-b.k do b.ch^[i]:=0;
b.k:=a.k;
end;
for i:=max(a.k,b.k) downto 1 do
begin
c.ch^[i]:=(ost+a.ch^[i]+b.ch^[i]) mod 10;
ost:=(ost+a.ch^[i]+b.ch^[i]) div 10
end;
if ost>0 then
begin
for i:=c.k downto 1 do c.ch^[i+1]:=c.ch^[i];
inc(c.k);
c.ch^[1]:=ost;
end;
end;
{_______________________________________}
function more(const a,b:num):boolean;
var i:integer;
begin
i:=1;
while (a.k>=i)and(b.k>=i)and(a.ch^[i]=b.ch^[i]) do inc(i);
more:=(a.ch^[i]>b.ch^[i])and(a.k>=b.k);
end;
{_______________________________________}
procedure vich (var a,b:num; var c:num);
var ost:integer;
i,l,j:tnom;
ob:boolean;
help:smas;
res:mas;
begin
newch(c);
if more(b,a) then
begin
c.sgn:=false;
l:=b.k;
b.k:=a.k;
a.k:=l;
ob:=a.sgn;
a.sgn:=b.sgn;
b.sgn:=ob;
help:=a.ch;
a.ch:=b.ch;
b.ch:=help;
end;
c.k:=a.k;
res:=a.ch^;
if b.k<a.k then
begin
l:=a.k-b.k;
for i:=b.k downto 1 do
b.ch^[i+l]:=b.ch^[i];
for i:=1 to l do
b.ch^[i]:=0;
b.k:=a.k;
end;
for i:=c.k downto 1 do
begin
if a.ch^[i]<b.ch^[i] then
begin
l:=i-1;
while a.ch^[l]=0 do dec(l);
dec(a.ch^[l]);
for j:=l+1 to i-1 do a.ch^[j]:=a.ch^[j]+9;
c.ch^[i]:=a.ch^[i]-b.ch^[i]+10;
end
else c.ch^[i]:=a.ch^[i]-b.ch^[i];
end;
a.ch^:=res;
end;
{______________________________________}
procedure umn (const a,b:num; var c:num);
var i,j:integer;
begin
newch(c);
if a.k+b.k-1>n then
writeln('The structure is too large.Enlarge digit number.Have a nice day!')
else
begin
c.k:=a.k+b.k-1;
for i:=1 to c.k do c.ch^[i]:=0;
for i:=a.k downto 1 do
for j:=b.k downto 1 do
begin
c.ch^[i+j-1]:=c.ch^[i+j-1]+(a.ch^[i]*b.ch^[j]) mod 10;
c.ch^[i+j]:=c.ch^[i+j]+(a.ch^[i]*b.ch^[j]) div 10;
end;
end;
end;
{_____________________________________}
procedure beautify(var a:num);
var i:tnom;
begin
while (a.ch^[1]=0)and(i<a.k) do
begin
for i:=1 to a.k do
a.ch^[i]:=a.ch^[i+1];
dec(a.k);
end;
end;