Школа программиста

Забыли пароль?
[задачи] [курсы] [олимпиады] [регистрация]
Логин:   Пароль:    
Скрыть меню
О школе
Правила
Олимпиады
Фотоальбом
Гостевая
Форум
Чат
Архив олимпиад
Архив задач
Состояние системы
Рейтинг
Курсы
Новичкам
Работа в системе
Алгоритмы
Курсы ККДП
Дистрибутивы
Ссылки

HotLog


 
{ арифметические алгоритмы: умножение длинных натуральных десятичных чисел }
{ Введенное число помещается поразрядно в массив 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;

{Умножение по Аль-Хорезми, в ROW - 1 число,в COL - 2 число}
{Результат пишется в конец массива ROW                    }
procedure Multiplying;
var i,j,cr,cc:integer;
    carry,sum:longint;
begin
    dp:=high(row); cr:=nr; cc:=nc;
    carry := 0;
    while (cc>0) do begin
        i:=cr; j:=cc; sum:=carry;
        while (i<=nr) and (j>=1) do begin
           sum:=sum+row[i]*col[j];
           inc(i); dec(j);
        end;
        row[dp]:=sum mod 10; dec(dp);
        carry:=sum div 10;
        if cr>1 then dec(cr) else dec(cc);
    end;
    while (carry<>0) do begin
        row[dp]:=carry mod 10;
        carry:=carry div 10;
        dec(dp);
    end;
    inc(dp);
end;

begin
     {обнуление массивов-множителей}
     fillchar(row,sizeof(row),0); fillchar(col,sizeof(col),0);
     {поразрядный ввод 1-го числа}
     writeln('введите 1-е число число:');
     c:=#0;
     while NOT(c in ['0'..'9']) do c:=readkey;
     nr:=0;
     while (c in ['0'..'9']) do begin
        write(c);
        inc(nr); row[nr]:=ord(c)-ord('0');
        c:=readkey;
     end;
     writeln;
     {поразрядный ввод 2-го числа}
     writeln('введите 2-е число число:');
     while NOT(c in ['0'..'9']) do c:=readkey;
     nc:=0;
     while (c in ['0'..'9']) do begin
        write(c);
        inc(nc); col[nc]:=ord(c)-ord('0');
        c:=readkey;
     end;
     writeln;
     {выхов процедуры умножения, затем - вызов процедуры вывода результата}
     Multiplying; PrintResult;
end.


Красноярский краевой Дворец пионеров, (c)2006 - 2017, ICQ: 151483



Труба Прагма на http://espa-sibir.ru - опт и розница.