Длинная арифметика

Поделиться124-01-2008 16:38:05

Автор: cooller
Ем "Растишку", курю куришку и бухаю бухашку! :-)
Откуда: Гомель
Зарегистрирован: 24-01-2008
Приглашений: 0
Сообщений: 90
Уважение: +3
Позитив: +5
Пол: Мужской
Возраст: 33 [1992-01-28]
Провел на форуме:
16 часов 35 минут
Последний визит:
10-03-2008 13:47:59

Все что связано с ней здесь!

Поделиться230-01-2008 19:21:10

Автор: Noxt
Администратор
Откуда: Беларусь, Гомель
Зарегистрирован: 23-01-2008
Приглашений: 0
Сообщений: 31
Уважение: +3
Позитив: +2
Пол: Мужской
Возраст: 33 [1991-11-15]
Провел на форуме:
1 день 2 часа
Последний визит:
21-04-2008 20:19:31

Сумма

Код:

const base=1000;  {основание}

var a,b,c:array[0..10000] of integer;      //Массивы где хранятся числа (по 3 цифры в ячейке)

procedure redln(var a:array of integer);    //Процедура чтения чисел
var ch:char; i:integer;
begin
   fillchar(a,sizeof(a),0);
    repeat read(ch);
    until ch in ['0'..'9'];

    while ch in ['0'..'9'] do
    begin
       for i:=a[0] downto 1 do
       begin
          a[i+1]:=a[i+1]+(a[i]*10) div base;
          a[i]:=(a[i]*10) mod base;
       end;
       a[1]:=a[1]+ord(ch)-48;
       if a[a[0]+1]>0 then inc(a[0]);
       read(ch);
    end;
end;

procedure wrt(a:array of integer);  //Процедура вывода ответа
var s:string;  i:integer;
begin
   write (a[a[0]]);
   for i:=a[0]-1 downto 1 do
   begin
      str(a[i],s);
      while length(s)<3 do s:='0'+s;
      write(s);
   end;
   writeln;
end;

procedure sum(a,b:array of integer; var c:array of integer);  //сама сумма
var i,k:integer;
begin
   fillchar(c,sizeof(c),0);
   if a[0]>b[0] then k:=a[0]  else k:=b[0];
   for i:=1 to k do
    begin
       c[i+1]:=(c[i]+a[i]+b[i]) div base;
       c[i]:=(c[i]+a[i]+b[i]) mod base;
    end;
    if c[k+1]=0 then c[0]:=k  else c[0]:=k+1;
end;

begin
   redln(a);
   redln(b);
   sum(a,b,c);
   wrt(c);
end.

0

Поделиться307-04-2008 12:40:42

Автор: Oddi
Новичок
Откуда: Almaty
Зарегистрирован: 07-04-2008
Приглашений: 0
Сообщений: 3
Уважение: +2
Позитив: +0
Пол: Мужской
Возраст: 34 [1991-02-07]
Провел на форуме:
1 час 24 минуты
Последний визит:
08-05-2008 10:00:28

Вооот моя прога для сложение двух больших чисел ну скажем 254 значное число а если точнее это будет 10 ^ 253 значное чило почему так а ? а потому что на экран можно максимум 255 символов на одну строку вот ну конечно можно было через файлы побольше сделать но так нормально тоже вот
а еще два числа неотрицательные

Код:

Uses Crt;

{$M 65520,0,655360}

type  Myarray = array [0..254] of integer;

var   a,b,c : Myarray;

procedure To_Read(var a:Myarray);

var   ch : char;
        i  : integer;

procedure swap(var x,y:integer);

var   z : integer;

begin
 z := x;
 x := y;
 y := z;
end;

begin
 write(' ');
 a[0] := 0;
 while NOT EOLN do
 begin
  read(ch);
  if NOT (ch in ['0'..'9']) then
   break;
  a[0] := a[0]+1;
  a[a[0]] := ord(ch)-ord('0');   
 end;
 readln;
 for i := 1 to (a[0] div 2) do
  swap(a[i],a[a[0]-i+1]);
end;

function max(a,b:integer) : integer;

begin
 if a > b then
  max := a
 else
  max := b;
end;

procedure Sum(a,b:Myarray;var c:Myarray);

var   i,r : integer;

begin
 c[0] := max(a[0],b[0]);
 r := 0;
 for i := 1 to c[0] do
 begin
  c[i] := a[i]+b[i]+r;
  r := c[i] div 10;
  c[i] := c[i] mod 10;
 end;
 if r > 0  then
 begin
  c[0] := c[0]+1;
  c[c[0]] := r;
 end;
end;

procedure To_Write(c:Myarray);

var   i : integer;

begin
 if max(a[0],b[0]) < c[0] then
  write('-')
 else
  write(' ');
 for i := 1 to c[0] do
  write('-');
 writeln;
 if max(a[0],b[0]) = c[0] then
  write(' ');
 for i := c[0] downto 1 do
  write(c[i]);
 readln;
end;

begin
 CLRSCR;
 TextColor(Green);
 writeln;
 writeln('Vidite dva chisla cherez perevod stroki tochnee 1-oe zatem ENTER zatem 2-chislo');
 writeln;
(*========================================================================================*)
 To_Read(a);
 writeln('+');
 To_Read(b);
(*========================================================================================*)
 Sum(a,b,c);
 To_Write(c);
end.

Отредактировано Oddi (07-04-2008 13:09:36)

+1

Поделиться407-04-2008 12:52:50

Автор: Oddi
Новичок
Откуда: Almaty
Зарегистрирован: 07-04-2008
Приглашений: 0
Сообщений: 3
Уважение: +2
Позитив: +0
Пол: Мужской
Возраст: 34 [1991-02-07]
Провел на форуме:
1 час 24 минуты
Последний визит:
08-05-2008 10:00:28

воот это уже другая прога но похожа на сумму но это вычитание двух чисел ииии ограниечение такие же вот
а еще первое число свегда больше либо равно второму вот

Код:

Uses Crt;

{$M 65520,0,655360}

type  Myarray = array [0..254] of integer;

var   a,b,c : Myarray;

procedure To_Read(var a:Myarray);

var   ch : char;
      i  : integer;

procedure swap(var x,y:integer);

var   z : integer;

begin
 z := x;
 x := y;
 y := z;
end;

begin
 write(' ');
 a[0] := 0;
 while NOT EOLN do
 begin
  read(ch);
  if NOT (ch in ['0'..'9']) then
   break;
  a[0] := a[0]+1;
  a[a[0]] := ord(ch)-ord('0');   
 end;
 readln;
 for i := 1 to (a[0] div 2) do
  swap(a[i],a[a[0]-i+1]);
end;

function max(a,b:integer) : integer;

begin
 if a > b then
  max := a
 else
  max := b;
end;

procedure Minus(a,b:Myarray;var c:Myarray);

var   i : integer;

begin
 c[0] := max(a[0],b[0]);
 for i := 1 to c[0] do
 begin
  c[i] := a[i]-b[i];
  if c[i] < 0 then
  begin
   c[i] := c[i]+10;
   a[i+1] := a[i+1]-1;
  end; 
 end;
 while (c[0] > 1) and (c[c[0]] = 0) do
  c[0] := c[0]-1;
end;

procedure To_Write(c:Myarray);

var   i : integer;

begin
 write(' ');
 for i := 1 to c[0] do
  write('-');
 writeln;
 for i := 1 to abs(c[0]-max(a[0],b[0]))+1 do
  write(' ');
 for i := c[0] downto 1 do
  write(c[i]);
 readln;
end;

begin
 CLRSCR;
 TextColor(Green);
 writeln;
 writeln('Vidite dva chisla cherez perevod stroki tochnee 1-oe zatem ENTER zatem 2-chislo');
 writeln;
(*========================================================================================*)
 To_Read(a);
 writeln('-');
 To_Read(b);
(*========================================================================================*)
 Minus(a,b,c);
 To_Write(c);
end.

Отредактировано Oddi (07-04-2008 13:10:40)

+1

Поделиться507-04-2008 13:08:11

Автор: Oddi
Новичок
Откуда: Almaty
Зарегистрирован: 07-04-2008
Приглашений: 0
Сообщений: 3
Уважение: +2
Позитив: +0
Пол: Мужской
Возраст: 34 [1991-02-07]
Провел на форуме:
1 час 24 минуты
Последний визит:
08-05-2008 10:00:28

Ёще хотелось бы сказать что все числа у меня неотрицательные вооот
вооот моя другая прога сравнение чисел
тем кто будет возмушаться ограничениями я возражу нет я лучше посоветую ведь на таких мелочях скажем скилетах уже строятся тела большие воооот

Код:

Uses Crt;

{$M 65520,0,655360}

type  Myarray = array [0..254] of integer;

var   a,b,c : Myarray;

procedure To_Read(var a:Myarray);

var   ch : char;
      i  : integer;

procedure swap(var x,y:integer);

var   z : integer;

begin
 z := x;
 x := y;
 y := z;
end;

begin
 write(' ');
 a[0] := 0;
 while NOT EOLN do
 begin
  read(ch);
  if NOT (ch in ['0'..'9']) then
   break;
  a[0] := a[0]+1;
  a[a[0]] := ord(ch)-ord('0');   
 end;
 readln;
 for i := 1 to (a[0] div 2) do
  swap(a[i],a[a[0]-i+1]);
end;

function Compare(a,b:Myarray) : integer;

var   i : integer;

begin
 if a[0] > b[0] then
 begin
  Compare := 1;
  exit;
 end;
 if a[0] < b[0] then
 begin
  Compare := 2;
  exit;
 end;
 for i := a[0] downto 1 do
 begin
  if a[i] > b[i] then
  begin
   Compare := 1;
   exit;
  end;
  if a[i] < b[i] then
  begin
   Compare := 2;
   exit;
  end;
 end;
 Compare := 0;
end;


begin
 CLRSCR;
 TextColor(Green);
 writeln;
 writeln('Vidite dva chisla cherez perevod stroki tochnee 1-oe zatem ENTER zatem 2-chislo');
 writeln;
(*========================================================================================*)
 To_Read(a);
 writeln;
 writeln('<>');
 writeln;
 To_Read(b);
(*========================================================================================*)
 writeln;
 Case Compare(a,b) of
  0 : write(' ='); (* ONI ravni *)
  1 : write(' >'); (* pervoe bol'she *)
  2 : write(' <'); (* vtoroe bol'she *)
 end;
 readln;
end.

0