Версия для печати темы

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;