Версия для печати темы
Форум «Всё о Паскале» _ Задачи _ Помогите отыскать ошибку в программе
Автор: Nemesis-201 25.12.2007 0:46
Написал код, но программа явно работает некорректно: выдаёт неверный четырёхугольник
Пожалуйста помогите найти ошибку
Код
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.
Автор: Malice 25.12.2007 2:46
Пальцем в небо - а скобка (s[1]*s[2]*s[3]*s[4]) за 32768 не зашкаливает ? Если да то надо поменять тип Integer на Longint.
Автор: Nemesis-201 25.12.2007 4:12
Цитата(Malice @ 24.12.2007 22:46)
Пальцем в небо - а скобка (s[1]*s[2]*s[3]*s[4]) за 32768 не зашкаливает ? Если да то надо поменять тип Integer на Longint.
Поменял но не помогло.
Автор: Michael_Rybak 25.12.2007 4:20
Покажи пример, на котором работает неправильно, и скажи, как должно быть.
Автор: Nemesis-201 25.12.2007 4:42
ну например:
Кол-во точек: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 25.12.2007 6:16
У тебя, видимо, неправильный критерий проверки принадлежности точки четырехугольнику.
Во-первых, он не обязательно выпуклый.
Во-вторых, даже для выпуклых такое не обязательно работает. Например, квадрат (0,0) - (1,1) и точка (2,2).
Для выпуклых можно сравнивать сумму модулей |s1|+|s2|+|s3|+|s4| с площадью четырехугольника.
А чтобы работало на любых, напиши процедуру, которая разбивает любой четырехугольник на два (очевидно, непересекающихся) треугольника, и работай с ними отдельно. По крайней мере, я бы делал так.
Автор: Nemesis-201 26.12.2007 0:42
Вот переписал программу разбил четырёхугольник на треугольники как сделать чтобы в ответе выводился четырёхугольник???
Код
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 26.12.2007 6:38
Ты не разбил на треугольники, ты просто выбросил четвертую вершину.
У тебя есть четырехугольник ABCD. Разбиваем его на треугольники ABD и CBD. Точка принадлежит ABCD тогда и только тогда, когда она принадлежит хотя бы одному из этих треугольников (условие or).
Еще нужно учесть, что если ABCD - не выпуклый, то сторона BD может лежать снаружи, и нужно делить вдоль другой диагонали, AC.
Автор: Nemesis-201 26.12.2007 13:27
Переделал в очередной раз но всё-равно не работает
Код
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 26.12.2007 16:18
молодец, уже почти. только ты запутался с максимумом.
удали массивы q и q1, зачем они? тебе ведь надо просто для текущего четырехугольника в одной переменной накопить количество попавших внутрь точек. объяви одну переменную q перед циклом for w, поставь end перед "if q1[w]> max1 then", и замени там q1[w] на q.
Автор: Nemesis-201 27.12.2007 2:26
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}
Автор: Michael_Rybak 27.12.2007 5:25
Всегда рад