{ арифметические алгоритмы: умножение длинных натуральных десятичных чисел }
{ Введенное число помещается поразрядно в массив 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] + 48));
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) - 48;
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) - 48;
c := readkey;
end;
writeln;
{ вызов процедуры умножения, затем - вызов процедуры вывода результата }
Multiplying;
PrintResult;
end.
