IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Задачка про длинную арифметику (помогите плиз)
сообщение
Сообщение #1


Гость






Вот пишу длинную арифметику но не знаю как написать вычисление факториала и чисел фибоначи. Помогите плиз)) Заранее благодарен.

Код
Unit  Dlinn;

Interface

const
n=100;
type
tnom=1..n;
tc=0..19;

mas=array[tnom] of tc;
smas=^mas;

num=record
ch:smas;
k:0..n;
sgn:boolean;
end;


procedure newch(var a:num);
procedure readch(var f:text; var a:num);
procedure writech(var f:text; const a:num);
function max (const a,b:integer):integer;
procedure sum (var a,b:num; var c:num);
function more(const a,b:num):boolean;
procedure vich (var a,b:num; var c:num);
procedure umn (const a,b:num; var c:num);
procedure beautify(var a:num);



Implementation

procedure newch(var a:num);
begin
new(a.ch);
a.k:=0;
a.sgn:=true;
end;
{_______________________________________}
procedure readch(var f:text; var a:num);
var i:tnom; c:char;
begin
newch(a);
i:=1;
while not seekeoln(f) do
      begin
      read(f,c);
       case c of
       '+':a.sgn:=true;
       '-':a.sgn:=false;
       else
           begin
           a.ch^[i]:=ord(c)-ord('0');
           inc(a.k);
           inc(i);
           end;
       end;
      end;
readln(f);
end;
{________________________________________}
procedure writech(var f:text; const a:num);
var i:tnom;
begin
if not a.sgn then write(f,'-');
for i:=1 to a.k do
    write(f,a.ch^[i]);
writeln(f);
writeln(f,'***********')
end;
{________________________________________}
function max (const a,b:integer):integer;
begin
if a>b then max:=a
else max:=b;
end;
{________________________________________}
procedure sum (var a,b:num; var c:num);
var s,ost:integer;
i:tnom;
begin
newch(c);
c.k:=max(a.k,b.k);
ost:=0;
if a.k<b.k then
   begin
   for i:=a.k downto 1 do a.ch^[i+b.k-a.k]:=a.ch^[i];
   for i:=1 to b.k-a.k do a.ch^[i]:=0;
   a.k:=b.k;
   end;
if a.k>b.k then
   begin
   for i:=b.k downto 1 do b.ch^[i+a.k-b.k]:=b.ch^[i];
   for i:=1 to a.k-b.k do b.ch^[i]:=0;
   b.k:=a.k;
   end;

for i:=max(a.k,b.k) downto 1 do
    begin
    c.ch^[i]:=(ost+a.ch^[i]+b.ch^[i]) mod 10;
    ost:=(ost+a.ch^[i]+b.ch^[i]) div 10
    end;
if ost>0 then
   begin
   for i:=c.k downto 1 do c.ch^[i+1]:=c.ch^[i];
   inc(c.k);
   c.ch^[1]:=ost;
   end;
end;
{_______________________________________}
function more(const a,b:num):boolean;
var i:integer;
begin
i:=1;
while (a.k>=i)and(b.k>=i)and(a.ch^[i]=b.ch^[i]) do inc(i);
more:=(a.ch^[i]>b.ch^[i])and(a.k>=b.k);
end;
{_______________________________________}
procedure vich (var a,b:num; var c:num);
var ost:integer;
i,l,j:tnom;
ob:boolean;
help:smas;
res:mas;
begin
newch(c);
if more(b,a) then
   begin
   c.sgn:=false;
   l:=b.k;
   b.k:=a.k;
   a.k:=l;
   ob:=a.sgn;
   a.sgn:=b.sgn;
   b.sgn:=ob;
   help:=a.ch;
   a.ch:=b.ch;
   b.ch:=help;
   end;
c.k:=a.k;
res:=a.ch^;
if b.k<a.k then
   begin
   l:=a.k-b.k;
   for i:=b.k downto 1 do
   b.ch^[i+l]:=b.ch^[i];
   for i:=1 to l do
   b.ch^[i]:=0;
   b.k:=a.k;
   end;
for i:=c.k downto 1 do
    begin
    if a.ch^[i]<b.ch^[i] then
       begin
       l:=i-1;
       while a.ch^[l]=0 do dec(l);
       dec(a.ch^[l]);
       for j:=l+1 to i-1 do a.ch^[j]:=a.ch^[j]+9;
       c.ch^[i]:=a.ch^[i]-b.ch^[i]+10;
       end
    else c.ch^[i]:=a.ch^[i]-b.ch^[i];
    end;
a.ch^:=res;
end;
{______________________________________}
procedure umn (const a,b:num; var c:num);
var i,j:integer;
begin
newch(c);
if  a.k+b.k-1>n then
    writeln('The structure is too large.Enlarge digit number.Have a nice day!')
else
    begin
    c.k:=a.k+b.k-1;
    for i:=1 to c.k do c.ch^[i]:=0;
    for i:=a.k downto 1 do
        for j:=b.k downto 1 do
            begin
            c.ch^[i+j-1]:=c.ch^[i+j-1]+(a.ch^[i]*b.ch^[j]) mod 10;
            c.ch^[i+j]:=c.ch^[i+j]+(a.ch^[i]*b.ch^[j]) div 10;
            end;
    end;
end;
{_____________________________________}
procedure beautify(var a:num);
var i:tnom;
begin
while (a.ch^[1]=0)and(i<a.k) do
      begin
      for i:=1 to a.k do
          a.ch^[i]:=a.ch^[i+1];
      dec(a.k);
      end;
end;
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Помощник капитана
****

Группа: Пользователи
Сообщений: 601
Пол: Мужской
Реальное имя: Артем

Репутация: -  2  +


Поиск и FAQ.


--------------------
Dum spiro spero!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 28.09.2020 19:21
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name