Book of tasks on programming. Old version

 

 by Aliaksandr N. Prykhodzka

 

обзор, hierarchy, alter, vector, goto, java, label, прямое включение, учебный материал, constructor, publishing house, компиляция, метод, visual basic
 

Pascal. Answers. Pc.12. Realization of algorithms. Operations over symbolic numbers



главная страница


Pc.12.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)<length(y) then pr:=false
                  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])<ord(m[i2])) then
                              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.

 

©   Aliaksandr Prykhodzka    1993 - 2007