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


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

Группа: Пользователи
Сообщений: 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 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 





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