Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 02.05.2011, 14:55   #1
outaccess
Новичок
Джуниор
 
Регистрация: 02.05.2011
Сообщений: 1
По умолчанию Алгоритм решения сравнений

Помогите пожалуйста разобраться, с ошибками работает процедура init. Буду очень признателен за помощь.

Program reshenie_sravnen;
{Uses crt;}
Const z=4;
Type dv_mass=array [1..z,1..100]of integer;
od_mass=array [1..100]of integer;
Var m1: dv_mass; a,b,m,r,w:integer; m2d_mass;

Function alg_Evklida(a,m:integer):integer;
Var r:integer;
Begin
a:=abs(a);
m:=abs(m);
repeat
r:=a mod m;
if a mod m = 0 then alg_Evklida:=m;
a:=m;
m:=r;
until r=0;
end;

Function form(var m2: od_mass;a,m:integer):integer;
Var i,q,zel_chast:integer;
Begin
i:=0;q:=0;
repeat
zel_chast:=a div m;
r:=a mod m;
if r>=0 then begin inc(i);m2[i]:=zel_chast; inc(q);end;
a:=m;
m:=r;
until r=0;
form:=q;
end;

Procedure init(var m1v_mass;m2: od_mass;w:integer);
Var i,j, x :integer;
Begin
j:=0;
i:=0;
x:=0;
For i:=1 to z do
Begin
if i=1 then
Begin
For j:=1 to w+1 do
Begin
if j<2 then m1[i,j]:=0;
if j>=2 then m1[i,j]:=j-2;
end;
end;
if i=2 then
Begin
m1[i,1]:=0;
j:=1;
x:=1;
For j:= 2 to w+1 do
Begin
m1[i,j]:=m2[x];
inc(x);
end;
end;
if i=3 then
Begin
m1[i,1]:=1;
For j:=2 to w+1 do
Begin
if j=2 then m1[i,j]:=m1[i-1,j]*m1[i,j-1] else m1[i,j]:=m1[i-1,j]*m1[i,j-1]+m1[i,j-2];
end;
end;
if i=4 then
Begin
m1[i,1]:=0;
For j:=2 to w+1 do
Begin
if j=2 then m1[i,j]:=1 else m1[i,j]:=m1[i-2,j]*m1[i,j-1]+m1[i,j-2];
end;
end;
end;
end;

Procedure srav(m1v_mass;w,m,b:integer);
Var i,j,x,k,Q:integer;
Begin
k:=m1[1,w];
Q:=m1[4,w];
if k mod 2 = 0 then x:=Q*b else x:=Q*b*(-1);
repeat
if x>m then x:=x-m;
until x<=m;
writeln('x ñðàâíèìî ñ ',x,' ïî ìîäóäþ ',m);
end;

Procedure srav1(m1v_mass;w,m,b,r:integer);
Var i,j,x,t,k,Q:integer;
Begin
k:=m1[1,w-1];
Q:=m1[4,w-1];
if k mod 2 = 0 then x:=Q*b else x:=Q*b*(-1);
repeat
if x>m then x:=x-m;
until x<=m;
For t:= 0 to r-1 do
write('x ñðàâíèìî ñ ',x+t*m,'ïî ìîäóäþ ',m);
end;

Begin
write('Ââåäè ÷èñëî ïåðåä íåèçâåñòíûì è ñðàâíèâàåìîå ÷èñëî: ');
read(a,b);
write('Ââåäè ìîäóëü: ');
read(m);
if alg_Evklida(a,m)=1 then
Begin
write('Ðåøåíèå ñðàâíåíèÿ åäèíñòâåííî. ');
writeln;
if abs(a)>abs(m) then
Begin
w:=form(m2,a,m);
init(m1,m2,w);
srav(m1,w,m,b);
end
else begin
w:=form(m2,m,a);
init(m1,m2,w);
srav(m1,w,m,b);
end;
end else
Begin
r:=alg_Evklida(a,m);
if b mod r = 0 then
Begin
write('Ñðàâíåíèå èìååò ',r,' ðåøåíèé/èÿ.');
a:=a div r;
b:=b div r;
m:=m div r;
if abs(a)>abs(m) then
Begin
w:=form(m2,a,m);
init(m1,m2,w);
srav(m1,w,m,b);
end
else begin
w:=form(m2,m,a);
init(m1,m2,w);
srav1(m1,w,m,b,r);
end;
end
else write('Ñðàâíåíèå ðåøåíèé íå èìååò.');
end;
End.
outaccess вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Алгоритм решения судоку Alistan Общие вопросы C/C++ 5 27.04.2011 16:00
Алгоритм решения задач на паскале Сергей75 Фриланс 10 10.12.2010 18:48
Алгоритм решения Naruto63 Помощь студентам 6 20.09.2009 22:47
Алгоритм решения квадратного неравенства? StakanpORTvejna Паскаль, Turbo Pascal, PascalABC.NET 8 28.04.2009 16:37
Подскажите алгоритм решения Blad47 Паскаль, Turbo Pascal, PascalABC.NET 1 10.11.2008 19:50