множество точек на плоскости

[s-andriano]

     (x:293;y:271),(x:294;y:261),(x:283;y:261),(x:289;y:259),(x:296;y:260),(x:289;y:257),(x:297;y:260),(x:295;y:274),(x:289;y:272),(x:296;y:255),
     (x:282;y:257),(x:290;y:255),(x:291;y:255),(x:295;y:268),(x:295;y:269),(x:291;y:259),(x:293;y:266),(x:299;y:267),(x:299;y:259),(x:293;y:260),
     (x:230;y:305),(x:247;y:309),(x:235;y:318),(x:236;y:308),(x:237;y:313),(x:231;y:314),(x:231;y:321),(x:231;y:310),(x:248;y:312),(x:245;y:311),
     (x:243;y:321),(x:244;y:311),(x:233;y:311),(x:239;y:309),(x:246;y:310),(x:239;y:307),(x:247;y:310),(x:245;y:324),(x:239;y:322),(x:246;y:305),
     (x:232;y:307),(x:240;y:305),(x:241;y:305),(x:245;y:318),(x:245;y:319),(x:241;y:309),(x:243;y:316),(x:249;y:317),(x:249;y:309),(x:243;y:310),
     (x:330;y:305),(x:347;y:309),(x:335;y:318),(x:336;y:308),(x:337;y:313),(x:331;y:314),(x:331;y:321),(x:331;y:310),(x:348;y:312),(x:345;y:311),
     (x:343;y:321),(x:344;y:311),(x:333;y:311),(x:339;y:309),(x:346;y:310),(x:339;y:307),(x:347;y:310),(x:345;y:324),(x:339;y:322),(x:346;y:305),
     (x:332;y:307),(x:340;y:305),(x:341;y:305),(x:345;y:318),(x:345;y:319),(x:341;y:309),(x:343;y:316),(x:349;y:317),(x:349;y:309),(x:343;y:310),
     (x:380;y:355),(x:397;y:359),(x:385;y:368),(x:386;y:358),(x:387;y:363),(x:381;y:364),(x:381;y:371),(x:381;y:360),(x:398;y:362),(x:395;y:361),
     (x:393;y:371),(x:394;y:361),(x:383;y:361),(x:389;y:359),(x:396;y:360),(x:389;y:357));

var i : longint;
  t : text;
begin
  if k < MaxP then
    for i := 0 to k-1 do
      p[i] := pp[i]
  else begin
    for i := 0 to MaxP-1 do
      p[i] := pp[i];
    for i := MaxP to k-1 do begin
      p[i].x := random(20)+430;
      p[i].y := random(20)+405;
    end;
  end;
  assign(t,'t.t');
  rewrite(t);
  for i := MaxP to k-1 do
    writeln(t,'(x:',p[i].x:1:0,';y:',p[i].y:1:0,'),');
  close(t);
end;

var
  p: array[0..n0-1] of tPoint;
  n : longint;
var
  l: array[1..n0,1..n0] of tLine;
  used: array[1..n0,1..n0] of boolean;

procedure TinManCalc;
var
  i,j,u,v: integer;
  s: set of byte;
begin
  writeln('   TinMan');
  // calculating all the lines
  for i:=1 to n do
    for j:=1 to i-1 do l[i,j]:= NormalLineByPoints(p[i-1],p[j-1]);

  // looking for equal lines
  for i:=1 to n do
    for j:=1 to i-1 do
      if not used[i,j] then begin
        s:= [];
        for u:=i to n do
          for v:=1 to u-1 do
            if EqualLines(l[i,j],l[u,v]) then begin
              used[u,v]:= true;
              Include(s,u);
              Include(s,v)
            end;
        if s<>[i]+[j] then begin
          writeln('set:');
          for u:=1 to n do
            if u in s then with p[u-1] do writeln('#',u,':   x=',x:5:2,'  y=',y:5:2);
          writeln
        end
      end;
end;

function GetDist2(x0,y0, x1,y1, x2,y2 : tReal): tReal;
var
  a,b,c,x3,y3 : extended;
begin
  if x1 <> x2 then begin
    if y1 <> y2 then begin
      a := (y1-y2)/(x1-x2);
      b := (y2*x1 - y1*x2)/(x1-x2);
      c := -1/a;
      x3 := (y0 - x0*c - b)/(a - c);
      y3 := (y0*a + x0 - b*c)/(a - c);
    end else begin
      x3 := x0;
      y3 := y1;
    end; // if y1 <> y2
  end else begin
    if y1 <> y2 then begin
      x3 := x1;
      y3 := y0;
    end else begin
      x3 := x1;
      y3 := y1;
    end; // if y1 <> y2
  end; // if x1 <> x2
  GetDist2 := sqr(x3-x0) + sqr(y3-y0);
end;


procedure AndrianoCalc;
var i,j,k,MaxN,LocN : longint;
begin
  writeln('   andriano');
  MaxN := 2;
  for i := 0 to n-3 do
    for j := i+1 to n-2 do begin
      LocN := 2;
        for k := j+1 to n-1 do
          if GetDist2(p[i].x, p[i].y,p[j].x, p[j].y,p[k].x, p[k].y) < e then
            inc(LocN);
      if MaxN < LocN then MaxN := LocN;
    end;
  writeln('MaxN: ',MaxN);
  for i := 0 to n-3 do
    for j := i+1 to n-2 do begin
      LocN := 2;
        for k := j+1 to n-1 do
          if GetDist2(p[i].x, p[i].y,p[j].x, p[j].y,p[k].x, p[k].y) < e then
            inc(LocN);
      if MaxN = LocN then begin
        with p[i] do writeln('#',i,':   x=',x:5:2,'  y=',y:5:2);
        with p[j] do writeln('#',j,':   x=',x:5:2,'  y=',y:5:2);
        for k := j+1 to n-1 do
          if GetDist2(p[i].x, p[i].y,p[j].x, p[j].y,p[k].x, p[k].y) < e then
            with p[k] do writeln('#',k,':   x=',x:5:2,'  y=',y:5:2);
        writeln;
      end;
    end;
end;

var t0,t1,t2 : longint;
begin
  n := 8;
  n := 9;
  n := 40;
  n := 70;
  n := 256;
  GetData(n, p);
  t0 := GetTickCount;
  TinManCalc;
  t1 := GetTickCount;
  AndrianoCalc;
  t2 := GetTickCount;
  writeln('Elapsed time: TinMan = ',(t1-t0)/1000:2:1,' s, andriano = ',(t2-t1)/1000:2:1,' s');
  writeln('Need Memory:  TinMan = ',(Sizeof(l) + sizeof(used) + sizeof(p))/1024:2:1,' Kb, andriano = ',sizeof(p)/1024:2:1,' Kb');
  readln;
end.

[evg_m]

мой вариант без хранения промежуточных данных.

M: array[1..N] of record X,Y: integer; end; //массив точек

function OneLine(i,j,k: integer): boolean; //собственно проверка три точки на одной прямой
begin
//  (y1-Y2)*X3-(x1-X2)*Y3 =(x1*Y2-X2*Y1) прямая пр. через две точки(1,2) в третьей (3)
  result:=(M[i].Y-M[j].Y)*M[k].X - (M[i].X-M[j].Y)*M[k].Y = M[i].X*M[j].Y - M[j].X*M[i].Y;
// вроде не наврал 
end;

почему так? не требует перехода к вещественной арифметике => нет приближенных вычислений =>не нужен учет погрешностей.

for i:=1 to N-1 do 
  for j:=i+1 to N do // перебираем все пары точек
  begin
    r:=false; //проверяем есть ли далее точка на этой прямой (обеспечиваем единственность вывода прямой)
    for k:=j+1 to N do begin
       if OneLine(i,j,k) then 
       begin
          r:=true;
          break;
       end;
    end; 
    if not r then begin 
      //все точки данной прямой уже пройдены (дальше не встретим ни одной) можно выводить
      r3:=false; проверяем пригодность (>3 точек) (ничего не храним так что считаем еще разок!)
      for k:=1 to j do 
//        if k<>i and k<>j and OneLine(i,j,k) then //хорошая линия (>3) и все точки пройдены
        if (k<>i) and (k<>j) and OneLine(i,j,k) then //хорошая линия (>3) и все точки пройдены
        begin
          r3:=true;
          break;  
        end;
      for k:=1 to j do // перечисление точек прямой в порядке ввода
//        if k=i or k=j or OneLine(i,j,k) then //такую точку надо вывести
        if (k=i) or (k=j) or OneLine(i,j,k) then //такую точку надо вывести
          ..............................
    end; 
  end;
end;

код не проверял, писал в блокноте просто как иллюстрацию к комментариям.

[s-andriano]

Сообщение от evg_m

почему так? не требует перехода к вещественной арифметике => нет приближенных вычислений =>не нужен учет погрешностей.

Как, оказывается, изящно можно сформулировать мысль:
"Дабы упростить себе жизнь, считаем координаты целыми, хотя из условия задачи это никак не следует".

[evg_m]

Как, оказывается, изящно можно сформулировать мысль:
"Дабы упростить себе жизнь, считаем координаты целыми, хотя из условия задачи это никак не следует".

Даже если так (координаты точек вещественные), то на общий алгоритм это никак не повлияет, все изменения коснуться только функции OneLine (проверка три точки на одной прямой). Не могу сразу сказать какие в точности это будут изменения (м.б. просто result:=abs(...)<=epsilon, а может более существенные, вычисление нормали и расстояния от точки до прямой, можем воспользоваться вашей функцией Getdist2).

P.S. Или другой подход к задаче.
Если не указано обратное, то исходные точки лежат в узлах координатной сетки => путем масштабирования всегда можно говорить о целочисленных координатах
А это всегда так, любое измерения проводится с заданной точностью.
Если не указано обратное, то точность расчетов должна быть абсолютной =>epsilon=0 => ....


а разве здесь не тоже

p: array[0..n0-1] of tPoint;

P.S. TPoint =record x,y: real; end; /// добрался, Увидел !

а вот замечание по алгоритму
1.

    r:=false; //проверяем есть ли далее точка на этой прямой (обеспечиваем единственность вывода прямой)
// было    for k:=j+1 to N do begin  //проверяем одну последнюю
    for k:=i+1to N do begin  // а надо (т.е. надо проверять что i j это две последних точки

2.

      r3:=false; проверяем пригодность (>3 точек) (ничего не храним так что считаем еще разок!)
// было      for k:=1 to j do 
   for k:=1to i do  // мы же знаем что дальше точек нет

Вообще цель была отказаться от этого пункта.

2. Сделать понятие линии однозначным. То есть, если две линии равны, то структуры, их определяющие, также должны быть равны. Предусмотреть функцию определения равенства линий.

Заменить на естественную упорядоченность линий по порядку точек
выбор линии по двум последним точкам

for i:=1 to N-1 do
for j:=i+1 to N do // перебираем все пары точек

r:=false; //проверяем есть ли далее точка на этой прямой (обеспечиваем единственность вывода прямой)

for k:=1 to j do // перечисление точек прямой в порядке ввода