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

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

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

 
 Ответить  Открыть новую тему 
> Построение выпуклой оболочки, нужна помощь...все совсем плохо=(
сообщение
Сообщение #1


ыыыыщщщщщщыыыы
**

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

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


Условие:
даны действительные числа x1,y1,x2,y2,...xn,yn известно что точки p1,p2,...pn с коорданатами (x1,y1),(x2,y2),...(xn,yn) попарно различны. Найти выпуклый многоугольник с вершинами в некоторых из точек p1,p2,..pn, который содержит все точки p1,p2,...pn. Многоугольник должен быть предоставлен последовательностью вершин.
ваще хз как делать, листинг, то что понял как делать lol.gif
uses crt;
const armax=100;
var x,y:array[1..armax] of integer;
i,j,n:integer;
begin
clrscr;
writeln('Kolichestvo tochek:');
read(n);
for i:=1 to n do
begin
writeln('x[',i,']');
read(x[i]);
writeln('y[',i,']');
read(y[i]);
end;
end.

Прошу помощи, завтра сдавать... mega_chok.gif

Сообщение отредактировано: Feagor -


--------------------
Никогда не задавайте вопрос, если не уверены, что хотите получить ответ...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Только при чем здесь сортировка массива - непонятно. Это, вообще говоря, называется Задача построения выпуклой оболочки

Добавлено через 6 мин.
Вообще-то это была ссылка, если что smile.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


ыыыыщщщщщщыыыы
**

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

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


ну я понял, спасибо, хоть появились мысли как делать lol.gif

Добавлено через 12 мин.
еще подскажите можно как-нить найти угол через 3 точки, не использую длины сторон


--------------------
Никогда не задавайте вопрос, если не уверены, что хотите получить ответ...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Michael_Rybak
*****

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

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


можно арктангенсы углов посчитать. для точек А, В, С - проводим горизонтальный луч AD вправо, и считаем углы BAD и CAD через арктангенс. а потом отнимаем. и аккуратно все случаи расположения точек В и С относительно А нужно рассмотреть, чтобы угол получался от 0 до 180.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


ыыыыщщщщщщыыыы
**

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

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


2 Michael_Rybak не это уже изврещение. lol.gif Кажись проще sqrt(sqr(x2-x1)+sqr(y2-y1)) а потом по теореме косинусов


--------------------
Никогда не задавайте вопрос, если не уверены, что хотите получить ответ...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


ыыыыщщщщщщыыыы
**

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

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


такс....код немного увеличился по идее должен работать, но не работает....по идее работать должен через алгоритм Gift Wrapping. Прошу помощи.


uses crt;
const armax=100;
var x,y,x1,y1:array[1..armax] of integer;
i,j,n,k:integer;
min_angle:real;
{------------------------------------------------------}
function ArcCos(arg:real):real;
var r:real;
begin
if (abs(arg)>1) then
begin
writeln(' Unavailable argument ');
halt;
end;
if abs(arg)<0.000001
then r := pi/2
else r := ArcTan(sqrt(1/arg/arg-1));
if arg<0 then r:=pi-r;
ArcCos := r;
end;
{------------------------------------------------------}

{------------------------------------------------------}
function angle(x1,y1,x2,y2,x3,y3:integer):real;
var l1,l2,l3,cosx:real;
begin
l1:=sqrt(sqr(x2-x1)+sqr(y2-y1));
l2:=sqrt(sqr(x3-x2)+sqr(y3-y2));
l3:=sqrt(sqr(x3-x1)+sqr(y3-y1));
cosx:=(l1*l1+l2*l2-l3*l3)/(2*l1*l2);
angle:=arccos(cosx);
end;
{------------------------------------------------------}


begin
clrscr;
writeln('Kolichestvo tochek:');
read(n);
j:=2;
min_angle:=4;
for i:=1 to n do
begin
writeln('x[',i,']');
read(x[i]);
writeln('y[',i,']');
read(y[i]);
end;
for i:=1 to n do
begin
if x[i]>x1[1] then x1[1]:=x[i];
if y[i]>y1[1] then y1[1]:=y[i];
end;
for i:=1 to n do
begin
if (angle((x1[1]+3),y1[1],x1[1],y1[1],x[i],y[i])<min_angle) and (x1[1]<>x[i]) and (y1[1]<>y[i]) then
begin
min_angle:=angle((x1[1]-3),y1[1],x1[1],y1[1],x[i],y[i]);
x1[2]:=x[i];
y1[2]:=y[i];
end;
end;
repeat
inc(j);
min_angle:=4;
for i:=1 to n do
begin
if (angle(x1[j-1],y1[j-1],x1[j],y1[j],x[i],y[i])<min_angle) and (x1[j]<>x[i]) and (y1[j]<>y[i]) then
begin
min_angle:=angle(x1[j-1],y1[j-1],x1[j],y1[j],x[i],y[i]);
x1[j]:=x[i];
y1[j]:=y[i];
end;
end;
until (x1[j]=x1[1]) and (y1[j]=y1[1]);
readkey;
end.


Сообщение отредактировано: Feagor -


--------------------
Никогда не задавайте вопрос, если не уверены, что хотите получить ответ...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






Ну, не сработал код на моих данных по самой прозаической причине: деление на 0 в строке:
cosx:=(l1*l1+l2*l2-l3*l3)/(2*l1*l2);


Вот этот код работает по тому же алгоритму, но отрабатывает вполне успешно:
Построение выпуклой оболочки множества
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


ыыыыщщщщщщыыыы
**

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

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


2 volvo спасибо конечно за рабочий код, но хотелось бы не тупо чужой код перерисовать, а найти ошибку в своем, не понимаю почему получается деление на ноль...


--------------------
Никогда не задавайте вопрос, если не уверены, что хотите получить ответ...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Гость






Цитата
но хотелось бы не тупо чужой код перерисовать, а найти ошибку в своем
Тогда начинай все с самого начала: твоя программа (вернее, ты, а не программа) ошибается уже на этапе
Цитата
Находим нижнюю-правую точку
У тебя точка находится неверно... А все почему? Потому, что ты с какой-то стати проверяешь отдельно координаты X и Y, а надо было сделать что-то типа:
  x1[1] := x[1]; y1[1] := y[1];
for i := 2 to n do begin
if y[i] < y1[1] then begin { очередная точка НИЖЕ? }
x1[1] := x[i]; y1[1] := y[i]; { Координаты одной точки - ВСЕГДА вместе, не надо разбивать }
end
else
if (y[i] = y1[1]) and (x[i] > x1[1]) then begin { на одной высоте, но ПРАВЕЕ? }
x1[1] := x[i]; y1[1] := y[i];
end;
end;

Вот тогда будет действительно вычисляться нижняя-правая точка... А у тебя вычислялось вообще непонятно что.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


ыыыыщщщщщщыыыы
**

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

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


урряяяя, с божьей помощи кажись заработала, терь просьба протестить, и поправить, если где-то ошибки...

uses crt,graph;
const armax=100;
var x,y,x1,y1:array[1..armax] of integer;
i,j,n,k:integer;
max_angle:real;
{------------------------------------------------------}
function ArcCos(arg:real):real;
var r:real;
begin
if (abs(arg)>1) then
begin
writeln(' Unavailable argument ');
halt;
end;
if abs(arg)<0.000001
then r := pi/2
else r := ArcTan(sqrt(1/arg/arg-1));
if arg<0 then r:=pi-r;
ArcCos := r;
end;
{------------------------------------------------------}

{------------------------------------------------------}
function angle(x1,y1,x2,y2,x3,y3:integer):real;
var l1,l2,l3,cosx:real;
begin
l1:=sqrt(sqr(x2-x1)+sqr(y2-y1));
l2:=sqrt(sqr(x3-x2)+sqr(y3-y2));
l3:=sqrt(sqr(x3-x1)+sqr(y3-y1));
cosx:=(l1*l1+l2*l2-l3*l3)/(2*l1*l2);
angle:=arccos(cosx);
end;
{------------------------------------------------------}


begin
clrscr;
writeln('Kolichestvo tochek:');
read(n);
j:=2;
max_angle:=0;
for i:=1 to n do
begin
writeln('x[',i,']');
read(x[i]);
writeln('y[',i,']');
read(y[i]);
end;
y1[1]:=y[1];
x1[1]:=x[1];
for i:=1 to n do
begin
if y[i]<y1[1] then begin y1[1]:=y[i]; x1[1]:=x[i]; end
else if (y[i]=y1[1]) and (x[i]>x1[1]) then
begin
y1[1]:=y[i]; x1[1]:=x[i];
end;
end;
for i:=1 to n do
begin
if (x1[1]<>x[i]) and (y1[1]<>y[i]) then if (angle((x1[1]-3),y1[1],x1[1],y1[1],x[i],y[i])>max_angle) then
begin
max_angle:=angle((x1[1]-3),y1[1],x1[1],y1[1],x[i],y[i]);
x1[2]:=x[i];
y1[2]:=y[i];
end;
end;
repeat
inc(j);
max_angle:=0;
for i:=1 to n do
begin
if (x1[j]<>x[i]) and (y1[j]<>y[i]) then if (angle(x1[j-1],y1[j-1],x1[j],y1[j],x[i],y[i])>max_angle) then
begin
max_angle:=angle(x1[j-1],y1[j-1],x1[j],y1[j],x[i],y[i]);
x1[j]:=x[i];
y1[j]:=y[i];
end;
end;
until (x1[j]=x1[1]) and (y1[j]=y1[1]);
writeln('Obolochka idet cherez tochki:');
for i:=1 to j do writeln('x[',i,']=',x1[i],' ','y[',i,']=',y1[i]);
readkey;
end.


Добавлено через 3 мин.
2 volvo насчет точки сам нашел ошибку smile.gif, вот уже когда код рабочий стал выкладывать увидел твой пост на эту тему....


--------------------
Никогда не задавайте вопрос, если не уверены, что хотите получить ответ...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Гость






Цитата
просьба протестить
Потестил. Неправильный результат выдает на тестовых последовательностях:

const armax=8;
var
x: array[1 .. armax] of integer = (
3, 6, 6, 5, 7, 7, 4, 9
);
y: array[1 .. armax] of integer = (
2, 1, 3, 4, 4, 6, 7, 7
);

Чтобы поправить, пришлось сделать так:


repeat
inc(j); { Заметь, ты увеличил J }
max_angle:=0;
for i:=1 to n do begin

{
идем "от обратного": если точка совпадает с двумя последними в оболочке - то
следующая итерация, иначе проверяем угол...
}
if ((x1[j-2]=x[i]) and (y1[j-2]=y[i])) or
((x1[j-1]=x[i]) and (y1[j-1]=y[i])) then continue
else begin

{
Я говорил, что ты увеличил J -
поэтому теперь надо брать 2 последних найденных точки именно так
}
if (angle(x1[j-2],y1[j-2],x1[j-1],y1[j-1],x[i],y[i])>max_angle) then begin
max_angle:=angle(x1[j-2],y1[j-2],x1[j-1],y1[j-1],x[i],y[i]);
x1[j]:=x[i];
y1[j]:=y[i];
end;
end;
end;
until (x1[j]=x1[1]) and (y1[j]=y1[1]);
Вот теперь этот тест проходит... Надо еще на нескольких проверить, чтобы быть уверенным что это работает правильно... Тестируй дальше smile.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


ыыыыщщщщщщыыыы
**

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

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


2 volvo спасибо за помощь!!!! Все работает прекрасно единственно модно добавить условие, что при поиске следующей точки, если несколько углов имеют одинаковый угол, являющийся максимальным, брать ту до которой расстояние больше...ысчо раз спасибо, считаю что тема себя исчерпала, и её можно закрыть, рабочий код:
uses crt;
const armax=100;
var x,y,x1,y1:array[1..armax] of integer;
i,j,n,k,gd,gm:integer;
max_angle:real;
{------------------------------------------------------}
function ArcCos(arg:real):real;
var r:real;
begin
if (abs(arg)>1) then
begin
writeln(' Unavailable argument ');
halt;
end;
if abs(arg)<0.000001
then r := pi/2
else r := ArcTan(sqrt(1/arg/arg-1));
if arg<0 then r:=pi-r;
ArcCos := r;
end;
{------------------------------------------------------}

{------------------------------------------------------}
function angle(x1,y1,x2,y2,x3,y3:integer):real;
var l1,l2,l3,cosx:real;
begin
l1:=sqrt(sqr(x2-x1)+sqr(y2-y1));
l2:=sqrt(sqr(x3-x2)+sqr(y3-y2));
l3:=sqrt(sqr(x3-x1)+sqr(y3-y1));
cosx:=(l1*l1+l2*l2-l3*l3)/(2*l1*l2);
angle:=arccos(cosx);
end;
{------------------------------------------------------}


begin
clrscr;
writeln('Kolichestvo tochek:');
read(n);
j:=2;
max_angle:=0;
for i:=1 to n do
begin
writeln('x[',i,']');
read(x[i]);
writeln('y[',i,']');
read(y[i]);
end;
y1[1]:=y[1];
x1[1]:=x[1];
for i:=1 to n do
begin
if y[i]<y1[1] then begin y1[1]:=y[i]; x1[1]:=x[i]; end
else if (y[i]=y1[1]) and (x[i]>x1[1]) then
begin
y1[1]:=y[i]; x1[1]:=x[i];
end;
end;
for i:=1 to n do
begin
if (x1[1]<>x[i]) and (y1[1]<>y[i]) then if (angle((x1[1]-3),y1[1],x1[1],y1[1],x[i],y[i])>max_angle) then
begin
max_angle:=angle((x1[1]-3),y1[1],x1[1],y1[1],x[i],y[i]);
x1[2]:=x[i];
y1[2]:=y[i];
end;
end;
repeat
inc(j);
max_angle:=0;
for i:=1 to n do
begin
if ((x1[j-2]=x[i]) and (y1[j-2]=y[i])) or
((x1[j-1]=x[i]) and (y1[j-1]=y[i])) then continue
else
begin
if (angle(x1[j-2],y1[j-2],x1[j-1],y1[j-1],x[i],y[i])>max_angle) then
begin
max_angle:=angle(x1[j-2],y1[j-2],x1[j-1],y1[j-1],x[i],y[i]);
x1[j]:=x[i];
y1[j]:=y[i];
end;
end;
end;
until (x1[j]=x1[1]) and (y1[j]=y1[1]);
writeln('Obolochka idet cherez tochki:');
for i:=1 to j-1 do writeln('x[',i,']=',x1[i],' ','y[',i,']=',y1[i]);
readkey;
end.


--------------------
Никогда не задавайте вопрос, если не уверены, что хотите получить ответ...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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