Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Построение выпуклой оболочки

Автор: Feagor 25.12.2007 0:58

Условие:
даны действительные числа 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

Автор: volvo 25.12.2007 1:04

Только при чем здесь сортировка массива - непонятно. Это, вообще говоря, называется http://algolist.manual.ru/maths/geom/convhull/

Добавлено через 6 мин.
Вообще-то это была ссылка, если что smile.gif

Автор: Feagor 25.12.2007 1:28

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

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

Автор: Michael_Rybak 25.12.2007 2:58

можно арктангенсы углов посчитать. для точек А, В, С - проводим горизонтальный луч AD вправо, и считаем углы BAD и CAD через арктангенс. а потом отнимаем. и аккуратно все случаи расположения точек В и С относительно А нужно рассмотреть, чтобы угол получался от 0 до 180.

Автор: Feagor 25.12.2007 14:12

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

Автор: Feagor 25.12.2007 15:38

такс....код немного увеличился по идее должен работать, но не работает....по идее работать должен через алгоритм http://algolist.manual.ru/maths/geom/convhull/gift.php. Прошу помощи.


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.

Автор: volvo 25.12.2007 15:50

Ну, не сработал код на моих данных по самой прозаической причине: деление на 0 в строке:

cosx:=(l1*l1+l2*l2-l3*l3)/(2*l1*l2);


Вот этот код работает по тому же алгоритму, но отрабатывает вполне успешно:
http://forum.sources.ru/index.php?showtopic=51648&view=findpost&p=348976

Автор: Feagor 25.12.2007 18:34

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

Автор: volvo 26.12.2007 14:40

Цитата
но хотелось бы не тупо чужой код перерисовать, а найти ошибку в своем
Тогда начинай все с самого начала: твоя программа (вернее, ты, а не программа) ошибается уже на этапе
Цитата
Находим нижнюю-правую точку
У тебя точка находится неверно... А все почему? Потому, что ты с какой-то стати проверяешь отдельно координаты 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;

Вот тогда будет действительно вычисляться нижняя-правая точка... А у тебя вычислялось вообще непонятно что.

Автор: Feagor 26.12.2007 15:25

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


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, вот уже когда код рабочий стал выкладывать увидел твой пост на эту тему....

Автор: volvo 26.12.2007 16:06

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

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

Автор: Feagor 28.12.2007 0:27

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.