Asya_inter

Здравствуйте,решаю такую задачу: Выбрать три различные точки из заданного множества точек на плоскости так, чтобы была минимальной разность между количествами точек, лежащих внутри и вне треугольника с вершинами в выбранных точках. Подскажите пожалуйста, как применить квад-дерево? ( этот способ сказали, будет быстрее, чем перебирать все возможные точки по три). Как вообще пишется такое решение, можете подсказать?

Asya_inter

Можете, пожалуйста посмотреть решение . А можно ли как-то изменить, чтобы сократить время выполнения?:

program nomer_20;
uses
graphabc;
const
nmax = 100;
t = 0.001;{точность сравнения вещественных чисел}
{площадь треугольника по координаьам вершин}
function Plos(x1, y1, x2, y2, x3, y3: real): real;
begin
Plos := abs((x1 - x2) * (y3 - y2) - (y1 - y2) * (x3 - x2)) / 2;
end;
{принадлежность точки треугольнику}
function Prin(x, y, x1, y1, x2, y2, x3, y3: real): boolean;
var
s, s1, s2, s3: real;
begin
s := Plos(x1, y1, x2, y2, x3, y3);
s1 := Plos(x, y, x1, y1, x2, y2);
s2 := Plos(x, y, x2, y2, x3, y3);
s3 := Plos(x, y, x1, y1, x3, y3);
Prin := abs(s - s1 - s2 - s3) <= t;
end;
{функция принадлежности отрезку}
function IsLine(x0, y0, x1, y1, x2, y2: real): boolean;
var
p: real;
begin
if x1 = x2 then {если отрезок вертикальный}
begin
if (x0 = x1) and (((y0 <= y1) and (y0 >= y2)) or ((y0 >= y1) and (y0 <= y2))) then IsLine := true
else IsLine := false;
end
else
begin
p := (x0 - x2) / (x1 - x2);
if (abs(p * y1 + (1 - p) * y2 - y0) < t) and ((p >= 0) and (p <= 1)) then IsLine := true
else IsLine := false
end;
end;
{положение точки, внутри, снаружи, на сторонах не считаем}
function Poloz(x0, y0, x1, y1, x2, y2, x3, y3: real): integer;
begin
{если принадлежит треугольнику, но не его сторонам, внутри}
if Prin(x0, y0, x1, y1, x2, y2, x3, y3) and not IsLine(x0, y0, x1, y1, x2, y2)
and not IsLine(x0, y0, x2, y2, x3, y3) and not IsLine(x0, y0, x1, y1, x3, y3) then
Poloz := -1
else Poloz := 1;{иначе снаружи}
end;

var
a: array[1..nmax, 1..2] of real;
x, y, n, i, j, k, m, mn, imn, jmn, kmn, kv, ks, mkv, mks: integer;
ms: real;
s: string;

begin
randomize;
repeat
write('Количество точек от 5 до ', nmax, ' n=');
read(n);
until n in [5..nmax];

for i := 1 to n do
begin
a[i, 1] := -10 + 20 * random;{координаты}
a[i, 2] := -10 + 20 * random;
end;
mn := n; {минимальная разница}
imn := 1;{номера вершин с минимальной разницей}
jmn := 2;
kmn := 3;
for i := 1 to n - 2 do
for j := i + 1 to n - 1 do
for k := j + 1 to n do
begin
kv := 0;ks := 0;
for m := 1 to n do
if not (m in [i, j, k]) then
begin
if Poloz(a[m, 1], a[m, 2], a[i, 1], a[i, 2], a[j, 1], a[j, 2], a[k, 1], a[k, 2]) = -1 then inc(kv)
else inc(ks);
end;
if abs(ks - kv) < mn then
begin
mn := abs(ks - kv);
kmn := k;
jmn := j;
imn := i;
mkv := kv;
mks := ks;
end;
end;
ms := (Window.Height - 50) / 20;{масштаб для перевода координат в экранные}
x := Window.Width div 2;{центр}
y := windowheight div 2;
setpencolor(clBlue);
for i := 1 to n do
begin
circle(x + round(ms * a[i, 1]), y - round(ms * a[i, 2]), 2);{все точки}

end;
{вершины минимального}
circle(x + round(ms * a[imn, 1]), y - round(ms * a[imn, 2]), 3);

circle(x + round(ms * a[jmn, 1]), y - round(ms * a[jmn, 2]), 3);
circle(x + round(ms * a[kmn, 1]), y - round(ms * a[kmn, 2]), 3);
setpencolor(clRed); {треугольник}
line(x + round(ms * a[imn, 1]), y - round(ms * a[imn, 2]), x + round(ms * a[jmn, 1]), y - round(ms * a[jmn, 2]));
line(x + round(ms * a[imn, 1]), y - round(ms * a[imn, 2]), x + round(ms * a[kmn, 1]), y - round(ms * a[kmn, 2]));
line(x + round(ms * a[kmn, 1]), y - round(ms * a[kmn, 2]), x + round(ms * a[jmn, 1]), y - round(ms * a[jmn, 2]));
setfontcolor(clBlue);
str(mkv, s);
textout(x - 50, windowheight - 40, 'Внутри=' + s);
str(mks, s);
textout(x - 50, windowheight - 20, 'Снаружи=' + s);
end.