Все что связано с ней здесь!
Длинная арифметика
Сообщений 1 страница 7 из 7
Поделиться230-01-2008 19:21:10
Сумма
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.
Поделиться307-04-2008 12:40:42
Вооот моя прога для сложение двух больших чисел ну скажем 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)
Поделиться407-04-2008 12:52:50
воот это уже другая прога но похожа на сумму но это вычитание двух чисел ииии ограниечение такие же вот
а еще первое число свегда больше либо равно второму вот
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)
Поделиться507-04-2008 13:08:11
Ёще хотелось бы сказать что все числа у меня неотрицательные вооот
вооот моя другая прога сравнение чисел
тем кто будет возмушаться ограничениями я возражу нет я лучше посоветую ведь на таких мелочях скажем скилетах уже строятся тела большие воооот
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.
Поделиться611-04-2008 22:07:12
Где-то мне попадалась рекомендация использовать для таких чисел тип Double.
245 знака в него по моему влезет.
Поделиться712-04-2008 12:55:06
неа в Доубль стока не влезет, да и не обязательно ж 254, можно и больше тот массив сделать)