Помогите отыскать ошибку в программе, Четырехугольник с наибольшем кол-вом точек Опции

[Nemesis-201]

Написал код, но программа явно работает некорректно: выдаёт неверный четырёхугольник
Пожалуйста помогите найти ошибку

Код

Program nktvch;
type
tk = record
x:integer;
y:integer;
end;
var
tx1, tx2, tx3, tx4, ty1, ty2, ty3, ty4: integer;
m: array[1..100] of tk;
s: array [1..4] of integer;
i,j,k,l,a,n,q,max:integer;

begin
writeln('Введите кол-во точек');
repeat
  readln(n);
  if (n<4) or (n>20) then
    writeln('Недопустимое кол-во');
until (n>=4) and (n<=20);
for i:=1 to n do
begin
  writeln('Введите ',i,' точку');
  write  ('      X[',i,']= ');
  readln(m[i].x);
  write  ('      Y[',i,']= ');
  readln(m[i].y)
end;
max:=0;
for i:=1 to n do
begin
  for j:=1 to n do
  begin
    for k:=1 to n do
    begin
      for l:=1 to n do
      begin
      if (i<>j) and (i<>k) and (i<>l) and (j<>k) and (j<>l) and (k<>l) then
    begin
    q:=0;
      for a:=1 to n do
      begin
        S[1]:=(m[a].x-m[i].x)*(m[j].y-m[i].y)-(m[a].y-m[i].y)*(m[j].x-m[i].x);
        S[2]:=(m[a].x-m[j].x)*(m[k].y-m[j].y)-(m[a].y-m[j].y)*(m[k].x-m[j].x);
        S[3]:=(m[a].x-m[k].x)*(m[l].y-m[k].y)-(m[a].y-m[k].y)*(m[l].x-m[k].x);
        S[4]:=(m[a].x-m[l].x)*(m[i].y-m[l].y)-(m[a].y-m[l].y)*(m[i].x-m[l].x);
        if (s[1]*s[2]*s[3]*s[4])>0 then
         q:=q+1;
      end;
if q>max then
      begin
        max:=q;
        tx1:=m[i].x;
        ty1:=m[i].y;
        tx2:=m[j].x;
        ty2:=m[j].y;
        tx3:=m[k].x;
        ty3:=m[k].y;
        tx4:=m[l].x;
        ty4:=m[l].y;
      end;
    end;
      end;
    end;
  end;
end;
writeln ('Четырехугольник с наибольшем кол-вом точек(',max,'):');
writeln (tx1,',',ty1);
writeln (tx2,',',ty2);
writeln (tx3,',',ty3);
writeln (tx4,',',ty4);
readln;
end.

Сообщение отредактировано: Nemesis-201 - 24.12.2007 20:55

[Malice]

Пальцем в небо - а скобка (s[1]*s[2]*s[3]*s[4]) за 32768 не зашкаливает ? Если да то надо поменять тип Integer на Longint.

[Nemesis-201]

Пальцем в небо - а скобка (s[1]*s[2]*s[3]*s[4]) за 32768 не зашкаливает ? Если да то надо поменять тип Integer на Longint.

Поменял но не помогло.

[Michael_Rybak]

Покажи пример, на котором работает неправильно, и скажи, как должно быть.

[Nemesis-201]

ну например:
Кол-во точек:8
Точки: (1,1) (1,4) (2,2) (2,3) (3,2) (3,3) (4,1) (4,4)
Должен выдать:(1,1) (1,4) (4,4) (4,1)
А он выдаёт:(1,1) (1,4) (2,2) (2,3)

[Michael_Rybak]

У тебя, видимо, неправильный критерий проверки принадлежности точки четырехугольнику.

Во-первых, он не обязательно выпуклый.

Во-вторых, даже для выпуклых такое не обязательно работает. Например, квадрат (0,0) - (1,1) и точка (2,2).

Для выпуклых можно сравнивать сумму модулей |s1|+|s2|+|s3|+|s4| с площадью четырехугольника.

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

[Nemesis-201]

Вот переписал программу разбил четырёхугольник на треугольники как сделать чтобы в ответе выводился четырёхугольник???

Код

Program cikl;
type
tk = record
x:integer;
y:integer;
end;
var
q:array [1..20] of integer;
t: array[1..4] of tk;
m: array[1..100] of tk;
s: array [1..4] of integer;
i,j,k,l,a,n,w,max:integer;
Const
   Epsilon = 1e-6;
Function InTriangle(X1,Y1,X2,Y2,X3,Y3,X,Y:Real):Boolean;
Function Dist(XX1,YY1,XX2,YY2:Real):Real;
Begin
Dist:=Sqrt (Sqr(XX2 - XX1) + Sqr(YY2 - YY1));
End;

Function Square(A,B,C:Real):Real;
Var P:Real;
Begin
P := (A + B + C) / 2;
Square := Sqrt (P * (P - A) * (P - B) * (P - C));
End;

Var
   Ab,Ac,Bc:Real;
   S,S1:Real;
   Da,Db,Dc:Real;
Begin
Ab := Dist(X1, Y1, X2, Y2);
Bc := Dist(X2, Y2, X3, Y3);
Ac := Dist(X1, Y1, X3, Y3);
S := Square(Ab, Bc, Ac);
Da := Dist(X1, Y1, X, Y);
Db := Dist(X2, Y2, X, Y);
Dc := Dist(X3, Y3, X, Y);
S1 := Square(Ac, Da, Dc) + Square(Ab, Db, Da) + Square(Bc, Db, Dc);
InTriangle := Abs(S - S1) < Epsilon;
End;

begin
writeln('Введите кол-во точек');
repeat
  readln(n);
  if (n<4) or (n>20) then
    writeln('Недопустимое кол-во');
until (n>=4) and (n<=20);
for i:=1 to n do
begin
  writeln('Введите ',i,' точку');
  write  ('      X[',i,']= ');
  readln(m[i].x);
  write  ('      Y[',i,']= ');
  readln(m[i].y)
end;
max:=0;
for i:=1 to n do
begin
  for j:=1 to n do
  begin
    for k:=1 to n do
    begin
      if (i<>j) and (i<>k) and (j<>k) then
    begin
  for w:=1 to n do
  begin
    q[w]:=0;
      for a:=1 to n do
      begin

        if InTriangle(m[i].x, m[i].y, m[j].x, m[j].y, m[k].x, m[k].y, m[a].x, m[a].y) then
         q[w]:=q[w]+1;
      end;
    if q[w]> max then
      begin
      max:=q[w];
        t[1].x:=m[i].x;
        t[1].y:=m[i].y;
        t[2].x:=m[j].x;
        t[2].y:=m[j].y;
        t[3].x:=m[k].x;
        t[3].y:=m[k].y;
        {t[4].x:=m[l].x;
                t[4].y:=m[l].y;}
      end;
          end;
  end;
  end;
  end;
  end;
writeln ('Четырехугольник с наибольшем кол-вом точек(',max,'):');
writeln (t[1].x,',',t[1].y);
writeln (t[2].x,',',t[2].y);
writeln (t[3].x,',',t[3].y);
{writeln (t[4].x,',',t[4].y); }
end.

[Michael_Rybak]

Ты не разбил на треугольники, ты просто выбросил четвертую вершину.

У тебя есть четырехугольник ABCD. Разбиваем его на треугольники ABD и CBD. Точка принадлежит ABCD тогда и только тогда, когда она принадлежит хотя бы одному из этих треугольников (условие or).

Еще нужно учесть, что если ABCD - не выпуклый, то сторона BD может лежать снаружи, и нужно делить вдоль другой диагонали, AC.

[Nemesis-201]

Переделал в очередной раз но всё-равно не работает

Код

Program cikl;
type
tk = record
x:integer;
y:integer;
end;
var
q,q1:array [1..20] of integer;
s: array[1..2] of integer;
t: array[1..4] of tk;
m: array[1..100] of tk;
i,j,k,l,a,n,w,w1,max,max1,smax:integer;
Const
   Epsilon = 1e-6;
Function InTriangle(X1,Y1,X2,Y2,X3,Y3,X,Y:Real):Boolean;
Function Dist(XX1,YY1,XX2,YY2:Real):Real;
Begin
Dist:=Sqrt (Sqr(XX2 - XX1) + Sqr(YY2 - YY1));
End;

Function Square(A,B,C:Real):Real;
Var P:Real;
Begin
P := (A + B + C) / 2;
Square := Sqrt (P * (P - A) * (P - B) * (P - C));
End;

Var
   Ab,Ac,Bc:Real;
   S,S1:Real;
   Da,Db,Dc:Real;
Begin
Ab := Dist(X1, Y1, X2, Y2);
Bc := Dist(X2, Y2, X3, Y3);
Ac := Dist(X1, Y1, X3, Y3);
S := Square(Ab, Bc, Ac);
Da := Dist(X1, Y1, X, Y);
Db := Dist(X2, Y2, X, Y);
Dc := Dist(X3, Y3, X, Y);
S1 := Square(Ac, Da, Dc) + Square(Ab, Db, Da) + Square(Bc, Db, Dc);
InTriangle := Abs(S - S1) < Epsilon;
End;

begin
writeln('Введите кол-во точек');
repeat
  readln(n);
  if (n<4) or (n>20) then
    writeln('Недопустимое кол-во');
until (n>=4) and (n<=20);
for i:=1 to n do
begin
  writeln('Введите ',i,' точку');
  write  ('      X[',i,']= ');
  readln(m[i].x);
  write  ('      Y[',i,']= ');
  readln(m[i].y)
end;
max1:=0;
for i:=1 to n do
begin
  for j:=i to n do
  begin
    for k:=1 to n do
    begin
     for l:=1 to n do

  if (i<>j) and (i<>k) and (i<>l) and (j<>k) and (j<>l) and (k<>l) then
  begin


         s[1]:=(m[k].x-m[i].x)*(m[j].y-m[i].y)-(m[k].y-m[i].y)*(m[j].x-m[i].x);
       s[2]:=(m[l].x-m[i].x)*(m[j].y-m[i].y)-(m[l].y-m[i].y)*(m[j].x-m[i].x);
       if s[1]*s[2]<0 then
      begin

        for w:=1 to n do
       q[w]:=0;

      begin

          if InTriangle(m[i].x, m[i].y, m[j].x, m[j].y, m[k].x, m[k].y, m[w].x, m[w].y) or
           InTriangle(m[i].x, m[i].y, m[j].x, m[j].y, m[l].x, m[l].y, m[w].x, m[w].y) then
         q1[w]:=q1[w]+1;

    if q1[w]> max1 then
      begin
      max1:=q1[w];
      t[1].x:=m[i].x;
             t[1].y:=m[i].y;
             t[2].x:=m[j].x;
             t[2].y:=m[j].y;
             t[3].x:=m[k].x;
             t[3].y:=m[k].y;
             t[4].x:=m[l].x;
             t[4].y:=m[l].y;
      end;
          end;

          end;
       end;

  end;
  end;
  end;

writeln ('Четырехугольник с наибольшем кол-вом точек(',max1,'):');
writeln (t[1].x,',',t[1].y);
writeln (t[3].x,',',t[3].y);
writeln (t[2].x,',',t[2].y);
writeln (t[4].x,',',t[4].y);
end.

[Michael_Rybak]

молодец, уже почти. только ты запутался с максимумом.

удали массивы q и q1, зачем они? тебе ведь надо просто для текущего четырехугольника в одной переменной накопить количество попавших внутрь точек. объяви одну переменную q перед циклом for w, поставь end перед "if q1[w]> max1 then", и замени там q1[w] на q.

[Nemesis-201]

Michael_Rybak Огромное тебе спасибо МЕГА РЕСПЕКТ ТЕБЕ


Вот мой финальный код:

Код

Program MKTVCH;
type
tk = record
x:integer;
y:integer;
end;
var
   s: array[1..2] of integer;
   t: array[1..4] of tk;
   m: array[1..100] of tk;
   i,j,k,l,n,w,q,max:integer;
Const
   Epsilon = 1e-6;
Function InTriangle(X1,Y1,X2,Y2,X3,Y3,X,Y:Real):Boolean;
Function Dist(XX1,YY1,XX2,YY2:Real):Real;
Begin
  Dist:=Sqrt (Sqr(XX2 - XX1) + Sqr(YY2 - YY1));
End;

Function Square(A,B,C:Real):Real;
Var P:Real;
Begin
  P := (A + B + C) / 2;
  Square := Sqrt (P * (P - A) * (P - B) * (P - C));
End;

Var
   Ab,Ac,Bc:Real;
   S,S1:Real;
   Da,Db,Dc:Real;
Begin
  Ab := Dist(X1, Y1, X2, Y2);
  Bc := Dist(X2, Y2, X3, Y3);
  Ac := Dist(X1, Y1, X3, Y3);
  S := Square(Ab, Bc, Ac);
  Da := Dist(X1, Y1, X, Y);
  Db := Dist(X2, Y2, X, Y);
  Dc := Dist(X3, Y3, X, Y);
  S1 := Square(Ac, Da, Dc) + Square(Ab, Db, Da) + Square(Bc, Db, Dc);
  InTriangle := Abs(S - S1) < Epsilon;
End;

begin{1}
  writeln('Введите кол-во точек');
  repeat
    readln(n);
    if (n<4) or (n>20) then
      writeln('Недопустимое кол-во');
  until (n>=4) and (n<=20);
  for i:=1 to n do
  begin{2}
    writeln('Введите ',i,' точку');
    write  ('      X[',i,']= ');
    readln(m[i].x);
    write  ('      Y[',i,']= ');
    readln(m[i].y)
  end;{2}
  max:=0;
  for i:=1 to n do
  begin{3}
    for j:=1 to n do
    begin{4}
      for k:=1 to n do
      begin{5}
       for l:=1 to n do
       begin{6}
         if (i<>j) and (i<>k) and (i<>l) and (j<>k) and (j<>l) and (k<>l) then
         begin{7}
            s[1]:=(m[k].x-m[i].x)*(m[j].y-m[i].y)-(m[k].y-m[i].y)*(m[j].x-m[i].x);
            s[2]:=(m[l].x-m[i].x)*(m[j].y-m[i].y)-(m[l].y-m[i].y)*(m[j].x-m[i].x);
             if s[1]*s[2]<0 then
             begin{8}
               Q:=0;
               for w:=1 to n do
               begin{9}
                 if InTriangle(m[i].x, m[i].y, m[j].x, m[j].y, m[k].x, m[k].y, m[w].x, m[w].y) or
                    InTriangle(m[i].x, m[i].y, m[j].x, m[j].y, m[l].x, m[l].y, m[w].x, m[w].y) then
                 q:=q+1;
               end;{9}
               if q> max then
               begin{10}
                  max:=q;
                  t[1].x:=m[i].x;
                  t[1].y:=m[i].y;
                  t[2].x:=m[j].x;
                     t[2].y:=m[j].y;
                  t[3].x:=m[k].x;
                  t[3].y:=m[k].y;
                  t[4].x:=m[l].x;
                  t[4].y:=m[l].y;
               end;{10}
             end;{8}
         end;{7}
       end;{6}
      end;{5}
    end;{4}
  end;{3}
  writeln ('Четырехугольник с наибольшем кол-вом точек(',max,'):');
  writeln (t[1].x,',',t[1].y);
  writeln (t[3].x,',',t[3].y);
  writeln (t[2].x,',',t[2].y);
  writeln (t[4].x,',',t[4].y);
  readln;
end.{1}

Сообщение отредактировано: Nemesis-201 - 26.12.2007 22:52

[Michael_Rybak]

Всегда рад