В заданном множестве точек на плоскости найдите четыре точки, которые могут служить вершинами квадрата - Pascal ABC

Формулировка задачи:

1)В заданном множестве точек на плоскости найдите четыре точки, которые могут служить вершинами квадрата.

Код к задаче: «В заданном множестве точек на плоскости найдите четыре точки, которые могут служить вершинами квадрата - Pascal ABC»

textual
const nmax=20; //макс. кол.точек
type Point=record //тип - точка
           x,y:integer;
           end;
//является ли квадратом
function Square(a,b,c,d:Point):boolean;
var s1,s2,s3,s4,s5,s6:Longint;
begin
s1:=sqr(a.x-b.x)+sqr(a.y-b.y);
s2:=sqr(a.x-c.x)+sqr(a.y-c.y);
s3:=sqr(a.x-d.x)+sqr(a.y-d.y);
s4:=sqr(b.x-c.x)+sqr(b.y-c.y);
s5:=sqr(b.x-d.x)+sqr(b.y-d.y);
s6:=sqr(c.x-d.x)+sqr(c.y-d.y);
Square:=((s1=s3)and(s1=s4)and(s1=s6)and(s2=s5)and(s2=2*s1))
     or ((s1=s2)and(s1=s5)and(s1=s6)and(s3=s4)and(s3=2*s1))
     or ((s2=s3)and(s2=s4)and(s2=s5)and(s1=s6)and(s1=2*s2));
end;
var t:array[1..nmax] of Point;///массив точек
    n,i,j,k,l,p,q:byte;
    f:boolean;
begin
repeat
write('Количество точек от 4 до ',nmax,' n=');
readln(n);
until n in [4..nmax];
writeln('Введите координаты ',n,' точек, целые числа:');
for i:=1 to n do
  begin
   writeln('Точка ',i);
   write('x=');readln(t[i].x);
   write('y=');readln(t[i].y);
  end;
clrscr;
writeln('Координаты:');
for i:=1 to n do
 begin
  write(i:2,'(',t[i].x,';',t[i].y,') ');
  if i mod 5=0 then writeln;
 end;
writeln;
//выбираем по 4 разных точки
f:=false;//нет квадрата
i:=1;
while(i<=n-3)and not f do
 begin
  j:=i+1;
  while(j<=n-2)and not f do
   begin
    k:=j+1;
    while(k<=n-1)and not f do
     begin
      l:=k+1;
      while(l<=n)and not f do
       begin
        if Square(t[i],t[j],t[k],t[l])then
         begin
          writeln('Есть 4 точки, образующие квадрат, это:');
          writeln(i:2,'(',t[i].x,';',t[i].y,') ');
          writeln(j:2,'(',t[j].x,';',t[j].y,') ');
          writeln(k:2,'(',t[k].x,';',t[k].y,') ');
          writeln(l:2,'(',t[l].x,';',t[l].y,') ');
          f:=true;
         end
        else inc(l);
       end;
      if not f then inc(k);
     end;
    if not f then inc(j);
   end;
  if not f then inc(i);
 end;
if not f then write('Никакие 4 точки не образуют квадрат');
end.
Эта работа вам не подошла?

Вы всегда можете заказать любую учебную работу у наших авторов от 20 руб.

8   голосов, оценка 4.250 из 5


СДЕЛАЙТЕ РЕПОСТ