28. Арифметические алгоритмы

Моделирование сложения двоичных чисел

{ ------------------------------------------------------------------------ }

var sr,sf,ss:string;

 

function BinAdd(s1,s2:string):string;

var s:string; l,i,d,carry:byte;

begin

    {выравнивание строк по длине}

    if length(s1)>length(s2) then while length(s2)<length(s1) do s2:='0'+s2

                             else while length(s1)<length(s2) do s1:='0'+s1;

    l:=length(s1);

    s:=''; carry:=0;

    for i:=l downto 1 do begin

       d := (ord(s1[i])-ord('0')) + (ord(s2[i])-ord('0')) + carry;

       carry := d div 2;

       d:=d mod 2;

       s:=char(d+ord('0')) + s;

    end;

    if carry<>0 then s:='1'+s;

    BinAdd:=s;

end;

 

begin

     writeln('введите 1-е двоичное число:');

     readln(sf);

     writeln('введите 2-е двоичное число:');

     readln(ss);

     sr:=BinAdd(sf,ss);

     writeln('результат сложения = ',sr);

end.

Моделирование вычитания двоичных чисел

{ ------------------------------------------------------------------------ }

var sr,sf,ss:string;

 

{ вычитание двоичных строк, первое число должно быть >= второго }

function BinSub(s1,s2:string):string;

var s:string; l,i,j:byte;

begin

    {выравнивание строк по длине}

    if length(s1)>length(s2) then while length(s2)<length(s1) do s2:='0'+s2

                             else while length(s1)<length(s2) do s1:='0'+s1;

 

    l:=length(s1); {начало алгоритма вычитания}

    s:='';

    for i:=l downto 1 do begin

       case s1[i] of

        '1': if s2[i]='0' then s:='1'+s else s:='0'+s;

        '0': if s2[i]='0' then s:='0'+s else begin

                s:='1'+s;

                if (s1[i-1]='1') then s1[i-1]:='0' else begin

                   j:=1;

                   while (i-j>0) and (s1[i-j]='0') do begin

                         s1[i-j]:='1';

                         inc(j);

                   end;

                   s1[i-j]:='0';

                end;

             end;

       end;

    end;

    {Уничтожение передних нолей}

    while (length(s)>1) and (s[1]='0') do delete(s,1,1);

    BinSub:=s;

end;

 

begin

     writeln('введите 1-е двоичное число:');

     readln(sf);

     writeln('введите 2-е двоичное число:');

     readln(ss);

     sr:=BinSub(sf,ss);

     writeln('результат вычитания = ',sr);

end.

Возведение целого числа в натуральную степень

 

Вариант 1 (обычный)

var x,y:integer;

 

function Degree(a,b:integer):longint;

var r:longint;

begin

     r:=1;

     while b>0 do begin

        r:=r*a;

        b:=b-1;

     end;

     Degree:=r;

end;

 

begin

    writeln('введите число и (через пробел) степень числа');

    readln(x,y);

    writeln(Degree(x,y)); { print x^y }

end.

 

Вариант 2 (более быстрый и эффективный)

var x,y:integer;

 

function Degree(a,b:integer):longint;

var r:longint; c:integer;

begin

     r:=1; c:=a;

     while b>0 do begin

        if odd(b) then begin

                       r:=r*c;

                       dec(b);

                  end else begin

                       c:=c*c;

                       b:=b div 2;

                  end;

     end;

     Degree:=r;

end;

 

begin

    writeln('введите число и (через пробел) степень числа');

    readln(x,y);

    writeln(Degree(x,y)); { print x^y }

end.

Умножение длинных натуральных десятичных чисел

{ Введенное число помещается поразрядно в массив ROW.                      }

{ Могут умножаться числа до 10000 разрядов                                 }

{ ------------------------------------------------------------------------ }

{$A+,B-,D+,E+,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}

{$M 16384,0,655360}

uses crt;

var {-------- use calc factorial ---------}

    row       : array[1..20000] of byte;

    col       : array[1..10000] of byte;

    nr,nc,dp  : integer;

    c         : char;

 

procedure PrintResult;

begin

     write('Р е з у л ь т а т = ');

     while (dp<=high(row)) do begin

        write(char(row[dp]+ord('0')));

        inc(dp);

     end;

     writeln;

end;