Построить множество всех различных выпуклых четырехугольников с вершинами в заданном множестве точек на плоскости

[alukardiko]

Построить множество всех различных выпуклых четырехугольников с вершинами в заданном множестве точек на плоскости.
Язык: Turbo Pascal

Для начала хочу узнать,как организовать перебор всех точек четверками без повторений?

[Sibedir]

Э-э-э, вроде так

для 1000 точек

for i1 := 1 to 997 do
  for i2 := i1+1 to 998 do
    for i3 := i2+1 to 999 do
      for i4 := i3+1 to 1000 do

[alukardiko]

Сообщение от Sibedir

Э-э-э, вроде так

для 1000 точек

for i1 := 1 to 997 do
  for i2 := i1+1 to 998 do
    for i3 := i2+1 to 999 do
      for i4 := i3+1 to 1000 do

Спасибо как раз в том месте я и повис.
Собственно вот сам код,оставлю его здесь.

program convex_quadrilateral;
const MaxDotCount = 100;
type dot=record x,y:real; end;
var
   epsilon:real;
   space:array [0..MaxDotCount] of dot;
   dotCount:integer;
   a,b,c,d,count,i:integer;
 
function getY(const a,b,c:integer):real;
         begin
              getY:=(space[c].x * (space[b].y - space[a].y) + space[a].y * space[b].x -
              space[b].y * space[a].x) / (space[b].x - space[a].x);
         end;
 
function onOneLine(const a,b,c:integer):boolean;
         begin
              if (abs(space[a].x-space[b].x)<=epsilon) then 
                  begin
                       if (abs (space[b].x - space[c].x) <= epsilon) then
                          onOneLine:=true else onOneLine:=false; 
                       exit;
                  end                  
                  else if (abs(space[a].y-space[b].y)<=epsilon) then
                           begin
                                if (abs (space[b].y - space[c].y) <= epsilon) then
                                    onOneLine:=true else onOneLine:=false;
                                exit;
                           end                                
                           else if (abs (space[c].y - getY (a, b, c)) <= epsilon) then
                                    onOneLine:=true
                                    else onOneLine:=false;
         end;
function diagonalRule(const a1,a2,b1,b2:integer):boolean;
         var
            y1,y2:real;
         begin
              if abs(space[a1].x - space[a2].x)<= epsilon then 
                  begin
                        if ((space[a1].x - space[b1].x) * (space[a1].x - space[b2].x)) < 0 then
                            diagonalRule:=true else diagonalRule:=false; 
                        exit;                        
                  end                      
                 else if (abs (space[a1].y - space[a2].y) <= epsilon) then begin
                          y1:=space[a1].y;
                          y2:=space[a1].y;
                      end
                         else begin
                                   y1:= getY (a1, a2, b1);
                                   y2:= getY (a1, a2, b2);
                              end;
              if ((y1 - space[b1].y) * (y2 - space[b2].y)) < 0 then
                  diagonalRule:=true else diagonalRule:=false;
end;

[alukardiko]

begin
     write('Vedite tochnost vichislenii epsilon=');
     readln(epsilon);
     writeln('Vvedite kol-vo tochek');
     readln(dotCount);
     for i:=0 to dotCount-1 do begin
         write('Vvedite x[',i,'] y[',i,']');
         readln(space[i].x,space[i].y);
         end;
     writeln('Resultat');
         if (dotCount < 4) then
             writeln('Ne hvataet tochek,minimum 4')
             else begin
                       count:=0;
                       for a:=0 to dotCount - 4 do
                begin
                           for b:= a + 1 to dotCount - 3 do
                                begin
                                 for c:= b + 1 to dotCount - 2 do
                                        begin
                                         if onOneLine (a, b, c)= false then
                                                begin
                                                  for d:= c + 1 to dotCount-1 do
                                                        begin
                                                      if (diagonalRule (a, c, b, d)=true) and (diagonalRule (b, d, a, c)=true) then begin
                                                          count:=count+1;
                                                          writeln (count,':',a, b, c, d);                                                        
                                                          end
 
                                                          else if (diagonalRule (a, b, c, d)=true) and (diagonalRule (c, d, a, b)=true) then begin
                                                                   count:=count+1;
                                                                   writeln (count,':',a, c, b, d);
                                                                   end
                                                                   else if (diagonalRule (a, d, b, c)=true) and (diagonalRule (b, c, a, d)=true) then 
                                                                        begin
                                                                             count:=count+1;
                                                                             writeln(count,':',a, b, d, c);
                                                                        end; 
                                                        end;
                                                end;
                                        end;
                                end;                                                                         
                end;
                      if count = 0 then 
                         writeln ('Net Vipuklih');
	 end;
     writeln ('Nazhmite lubuu klavishu');
     readln;
end.

[KirillP123]

Столкнулся с той же задачей что и автор, сперва обрадовался наличию решения, но понять его не получается. Опишите пожалуйста алгоритм работы программы на словах(хотя бы для функций)

[Poma][a]

Опишите пожалуйста алгоритм работы программы на словах(хотя бы для функций)

Конечно, мой генерал!

[Sibedir]

Э-э-э, вроде так

1. перебрать все 4-угольники
2. выбрать выпуклые

[KirillP123]

Сообщение от Sibedir

Э-э-э, вроде так

1. перебрать все 4-угольники
2. выбрать выпуклые

Я так понимаю что последние 2 функции проверяют условия выпуклости. А вот для чего функция GetY и что она считает ума не приложу

[Sibedir]

Да кто ее там разберет-то. Эт надо ударяться в математику. Оно тебе надо? Работает и ладно (кстати, я лично не проверял работает или нет). А если хочешь разобраться, то надо разобраться, и разобраться самому. Напиши сам с нуля и все сразу поймешь.

[programmer3]

Есть вариант функции(точнее 2 функции), проверяющей любые 4 произвольные точки на выпуклость четырехугольника, построенного на этих точках:

function F(x3,y3,x4,y4,x1,y1,x2,y2:integer) : boolean;
Var k1,k2,b1,b2 : real;

begin
if x3=x4 then begin
if(((x1<x3)and(x2<x3))or((x1>x3)and (x2>x3)))then f:=false
else f:=true;
end

else begin
k1:=(y3-y4)/(x3-x4);
b1:=(x3*y4-x4*y3)/(x3-x4);

if(((y1<k1*x1+b1)and(y2<k1*x2+b1))o r((y1>k1*x1+b1)and(y2>k1*x2+b1))) then f:=false
else f:=true;
end;
end;


{-------------------------------------------------}


function Fp(x1,y1,x2,y2,x3,y3,x4,y4:integer) : boolean; //Главная функция
begin
if (F(x1,y1,x2,y2,x3,y3,x4,y4)=true)an d(F(x3,y3,x4,y4,x1,y1,x2,y2)=false) then
fp:=false
else if (f(x1,y1,x3,y3,x2,y2,x4,y4)=true)an d(f(x2,y2,x4,y4,x1,y1,x3,y3)=false) then
fp:=false
else if (f(x1,y1,x4,y4,x3,y3,x2,y2)=true)an d(f(x3,y3,x2,y2,x1,y1,x4,y4)=false) then
fp:=false
else fp:=true;
end;


{-------------------------------------------------}