Заданы координаты N точек (X1,Y1), ..., (XN,YN). Опеределить, имеются ли среди них три точки, лежащие на одной прямой, если да, вывести их координаты.

Приведённая ниже программа выводит все тройки точек, лежащие на одной прямой, если таковые имеются. Её основная идея тривиальна - проверить все тройки точек, посчитав расстояния R1, R2, R3 между ними. Если R1=R2+R3 или R2=R1+R3 или R3=R1+R2, то точки лежат на одной прямой.

const n=30;
type point=array [1..2] of real;
 points=array [1..n] of point;
var p:points;

function dist (a,b:point):real; {Расстояние между точками}
begin dist:=sqrt(sqr(a[1]-b[1])+sqr(a[2]-b[2])); end;

procedure gen (var p:points); {Генерация координат точек km -10 до 10}
var i,j,k:integer;
begin randomize;
 for i:=1 to n do begin
  repeat {Не дает генерировать совпадающие точки, может зациклить,
         если точек очень много!}
   p[i,1]:=round(random*20-10);
   p[i,2]:=round(random*20-10);
   k:=0;
   for j:=1 to i-1 do if (p[j,1]=p[i,1]) and (p[j,2]=p[i,2]) then inc(k);
  until k=0;
 end;
end;

procedure print (p:point); {Печать точки}
begin write ('(',p[1]:0:1,',',p[2]:0:1,') '); end;

procedure straight_eq (a,b:point); {Вывести уравнение прямой по 2 точкам}
var kr,br:real;
begin
 if b[1]=a[1] then begin write (' x=',b[1]:0:2); exit; end;
 kr:=(b[2]-a[2])/(b[1]-a[1]);
 br:=a[2]-kr*a[1];
 if (kr=0) and (br=0) then begin write (' y=0.00'); exit; end;
 write (' y=');
 if kr<>0 then begin
  if kr=-1 then write ('-');
  if abs(kr)<>1 then write (kr:0:2,'*');
  write ('x');
  if br>0 then write ('+');
 end;
 if br<>0 then write (br:0:2);
end;

var i,j,k,l:integer; r1,r2,r3:real;
begin
 gen (p);
 writeln ('Сгенерированные точки');
 for i:=1 to n do print (p[i]);
 writeln; write ('Результаты');
 l:=0;
 for i:=1 to n-2 do
 for j:=i+1 to n-1 do begin
  r1:=dist(p[i],p[j]);
  for k:=j+1 to n do begin
   r2:=dist(p[j],p[k]);
   r3:=dist(p[i],p[k]);
   if (r1+r2=r3) or (r1+r3=r2) or (r2+r3=r1) then begin
    inc(l);
    writeln;
    print (p[i]); print (p[j]); print (p[k]);
    straight_eq (p[i],p[j]);
   end;
  end;
 end;
 writeln;
 if l=0 then writeln ('Точек не найдено')
 else writeln ('Всего сочетаний из 3 точек: ',l);
 reset (input); readln;
end.

гостевая; E-mail