Задача №6

На двумерной плоскости задано N точек с координатами (X₁,Y₁), (X₂,Y₂), ..., (X_n,Y_n). Написать программу, которая из этих точек выделяет вершины квадрата, содержащего максимальное число заданных точек.

ПРИМЕЧАНИЕ: предполагается, что точки, расположенные на сторонах квадрата, принадлежат ему.

Это переборная задача. Обратите внимание, что стороны квадрата могут и не быть параллельны осям координат! Каждую из N точек мы последовательно рассматриваем в качестве верхнего левого угла квадрата, каждую из оставшихся N-1 - как нижнюю правую вершины и смотрим, есть ли для них в этом множестве из N точек точки, соответствующие верхнему правому и нижнему левому углу. Если да, то подсчитываем, сколько точек лежат в данном квадрате.

Пусть координата левого верхнего угла (x₁,y₁), нижнего правого (x₂,y₂), тогда координата пересечения диагоналей четырехугольника ((x₁+x₂)/2,(y₁+y₂)/2); координата верхнего правого угла

((x₁+x₂)/2+[y₁-(y₁+y₂)/2],(y₁+y₂)/2+[x₁-(x₁+x₂)/2])= =((x₁+x₂+y₁-y₂)/2, (x₁-x₂+y₁+y2)/2), нижнего левого - ((x₁+x₂-y₁+y₂)/2,(-x₁+x₂+y₁+y₂)/2)

(Постройте чертеж и проверьте !).

Для (x₁,y₂) и (x₂,y₂) должны выполняться следующие неравенства: x₁<=x₂, y₁>=y₂ (иначе это будут уже не левый верхний и правый нижний углы квадрата).

Программа:

{В исходном множестве поочередно перебираются все пары точек.}

{Предполагая, что отрезок, соединяющий эти точки, является ребром}

{квадрата строим квадрат и смотрим, все ли его вершины имеются в}

{исходном множестве. Если все, то определяем, сколько точек из}

{исходного множества лежит внутри этого квадрата. Если это число}

{превосходит старый рекорд то запоминаем найденный квадрат.}

{ }

{$A-,B-,D-,E+,F-,I+,L-,N-,O-,R-,S-,V-}

{$M 65520,0,655360}

uses crt;

const

maxn = 100;{ Максимальное число точек }

type

xy = record x,y : real end; { Тип для записи координат точек }

var

m : array[1..maxn] of xy; { Координаты точек множества }

i,j,g,k,n,p : word; { вспомогательные переменные }

num : word; { для записи числа точек в текущем квадрате }

rec : word; { для записи числа точек в лучшем квадрате }

a1,b1,c1 : real; { вспомогательные переменные }

r,c : array[1..5] of xy;{ для записи вершин квадратов }

f1,f2 : boolean;

o : array[1..4] of shortint;

Function sign(a : real) : shortint;{ Функция signum }

begin

if a<0 then sign:=-1

else if a>0 then sign:=1

else sign:=0

end;

{ нахождение коэффициентов прямой,

проходящей через точки x1,y1 и x2,y2 }

procedure getabc(x1,y1,x2,y2:real; var a,b,c:real);

begin

a:=y2-y1; b:=x1-x2; c:=-(a*x1+b*y1)

end;

begin

write('Введите число точек...'); readln(n);

for i:=1 to n do

begin

write('Введите координаты ',i,'-ой точки...');

readln(m[i].x,m[i].y); end;

rec:=0;{ Обнуление рекорда }

for i:=1 to n do

{ Перебор всех квадратов, для которых отрезок m[i]-m[j] }

for j:=1 to n do { является ребром }

if i<>j then

begin

c[1]:=m[i]; c[2]:=m[j];

{ Определение вершин квадрата }

c[3].x:=c[2].x+(c[1].y-c[2].y);

c[3].y:=c[2].y+(c[2].x-c[1].x);

c[4].x:=c[1].x+(c[1].y-c[2].y);

c[4].y:=c[1].y+(c[2].x-c[1].x);

c[5]:=c[1];

num:=0;

{ Проверка на наличие всех вершин квадрата

в исходном множестве точек }

f1:=false; f2:=false;

for g:=1 to n do

if (m[g].x=c[3].x) and (m[g].y=c[3].y) then f1:=true;

for g:=1 to n do

if (m[g].x=c[4].x) and (m[g].y=c[4].y) then f2:=true;

if (c[1].x=c[2].x) and (c[1].y=c[2].y) then f1:=false;

if f1 and f2 then

{Если все вершины квадрата есть в исходном множестве}

for k:=1 to n do { то определяем число точек в квадрате}

begin

for g:=1 to 4 do

begin

getabc(c[g].x,c[g].y,c[g+1].x,c[g+1].y,a1,b1,c1);

o[g]:=sign(a1*m[k].x+b1*m[k].y+c1);

end;

if ((o[1]=o[2]) and (o[2]=o[3]) and (o[3]=o[4])) or

((o[1]=o[2]) and (o[2]=o[3]) and (o[4]=0)) or

((o[1]=o[2]) and (o[2]=o[4]) and (o[3]=0)) or

((o[1]=o[3]) and (o[3]=o[4]) and (o[2]=0)) or

((o[2]=o[3]) and (o[3]=o[4]) and (o[1]=0)) or

((m[k].x=c[1].x) and (m[k].y=c[1].y)) or

((m[k].x=c[2].x) and (m[k].y=c[2].y)) or ((m[k].x=c[3].x)

and (m[k].y=c[3].y)) or ((m[k].x=c[4].x)

and (m[k].y=c[4].y)) then inc(num);

end;

if rec<num then begin r:=c; rec:=num end;

end;

if rec=0 then { Не найдено ни одного квадрата }

begin

writeln('Не найдено ни одного квадрата.'); halt

end;

{ Вывод результатов }

write('Лучший квадрат : ');

for i:=1 to 3 do write('(',r[i].x:2:2,