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

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

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 04.12.2011, 20:17   #1
Nurik1
Новичок
Джуниор
 
Регистрация: 19.11.2011
Сообщений: 2
По умолчанию геометрическая задача

даны действительные числа x1,y1,x2,y2,...,xn,yn...Известно что точки p1,p2,...pn с координатами (x1,y1,(x2,y2),...,(xn,yn) попарно различны. Найти выпуклый многоугольник с вершинами в некоторых из точек p1,p2,...,pn, который содержит все точки p1,p2,...,pn. Многоугольник должен быть представлен последовательностью вершин
Nurik1 вне форума Ответить с цитированием
Старый 05.12.2011, 11:34   #2
puporev
Старожил
 
Регистрация: 13.10.2007
Сообщений: 2,740
По умолчанию

Пример построения выпуклой оболочки.
Код:
uses crt,graph;
type TPoint=record
            x,y: real;
            end;
     Tvyp=record
          x,y:real;
          k:integer;{номер точки}
          end;

const maxn=100;
 
{находится ли точка левее луча}
function IsLeft(p,p1,p2:TPoint):boolean;
begin
IsLeft:=(p1.x-p.x)*(p2.y-p.y)-(p1.y-p.y)*(p2.x-p.x)>0;
end;

var n,m,i,t1,t,newt:integer;
    x0,y0:integer;
    ms:real;
    s:string;
    p:array [1..maxn] of TPoint; {Точки множества}
    p1:array [1..maxn] of TVyp; {Точки выпуклой оболочки}
    used:array [1..maxn] of boolean;{Принадлежит-не принадлежит оболочке}
begin
clrscr;
randomize;
write('Количество точек n=');
readln(n);
writeln('Множество точек:');
for i:=1 to n do
 begin
  p[i].x:=-10+20*random;
  p[i].y:=-10+20*random;
  write('P[',i:2,'](',p[i].x:5:2,';',p[i].y:5:2,')  ');
  if i mod 4=0 then writeln;
 end;
t1:=1;{первая точка}
for i:=1 to n do
 begin
  if (p[i].y<p[t1].y) then t1:=i else
  if (p[i].y=p[t1].y) and (p[i].x<p[t1].x) then t1:=i;
 end;
FillChar(used,SizeOf(used),false);
writeln;
writeln;
writeln('Выпуклая оболочка идет через вершины: ');
t:=t1;
m:=0;
repeat
m:=m+1;
p1[m].x:=p[t].x;p1[m].y:=p[t].y;p1[m].k:=t;
used[t]:=true;
newt:=0;
{ Поиск следующей вершины }
for i:=1 to n do
if i<>t then
if (newt=0) or (IsLeft(p[t], p[i], p[newt]))then newt:=i;
t:=newt;
until t=t1;
for i:=1 to m do
write('P[',p1[i].k:2,'](',p1[i].x:5:2,';',p1[i].y:5:2,')  ');
if i mod 4=0 then writeln;
m:=m+1;
p1[m].x:=p1[1].x;p1[m].y:=p1[1].y;{замкнем оболочку}
writeln;
writeln;
write('Нажмите Enter для проверки результата графически');
readln;
initgraph(x0,y0,'');
x0:=getmaxX div 2;
y0:=getmaxY div 2;
ms:=(y0-10)/10;
line(x0-y0+10,y0,x0+y0-10,y0);
outtextXY(x0+y0,y0-15,'X');
line(x0,10,x0,getmaxY-10);
outtextXY(x0+5,10,'Y');
outtextXY(x0+5,y0+15,'0');
for i:=1 to 10 do
 begin
  line(x0-3,y0-round(i*ms),x0+3,y0-round(i*ms));{засечки на оси У}
  line(x0-3,y0+round(i*ms),x0+3,y0+round(i*ms));
  line(x0+round(i*ms),y0-3,x0+round(i*ms),Y0+3); {засечки на оси Х}
  line(x0-round(i*ms),y0-3,x0-round(i*ms),Y0+3);
  str(i,s);
  {подпись оси У}
  outtextXY(x0-35,y0-round(i*ms),s);{соответственно засечкам}
  outtextXY(x0-35,y0+round(i*ms),'-'+s);
  {подпись оси Х}
  outtextXY(x0+round(i*ms),y0+10,s);
  outtextXY(x0-round(i*ms),y0+10,'-'+s);
 end;
setcolor(14);
moveto(x0+round(p1[1].x*ms),y0-round(p1[1].y*ms));
for i:=1 to m do
lineto(x0+round(p1[i].x*ms),y0-round(p1[i].y*ms));
setcolor(12);
for i:=1 to n do
 begin
  circle(x0+round(p[i].x*ms),y0-round(p[i].y*ms),1);
  str(i,s);
  outtextXY(x0+round(p[i].x*ms)+5,y0-round(p[i].y*ms),s);
 end;
readln
end.
puporev вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
геометрическая задача Nurik1 Паскаль, Turbo Pascal, PascalABC.NET 3 20.11.2011 12:07
С++. Геометрическая задача. student71 Помощь студентам 0 11.05.2011 01:28
ГЕОМЕТРИЧЕСКАЯ ЗАДАЧА С++ kochet-kov Помощь студентам 8 22.12.2010 18:39
Геометрическая задача С++ bloo[d] Общие вопросы C/C++ 9 30.01.2008 18:27