Search code examples
delphigeometrylinepascal

Are points on max. two lines?

I have a time problem with my program. Given a set of points, it has to say whether all of those points are lying on two different lines.

I wrote code, which has points in array and removes one by one and try calculate it's vector.

But this solution is slow, because it must control all cases of lines. On input with 10,000 points it takes over 10 seconds.

Can someone please tell me if, is here better solution for this problem?

I made this code in Pascal:

    uses
  math;

type
  TPoint = record
    x, y: real;
  end;

  TList = array of TPoint;

function xround(value: real; places: integer): real;
var
  muldiv: real;
begin
  muldiv := power(10, places);
  xround := round(value * muldiv) / muldiv;
end;

function samevec(A, B, C: TPoint): boolean;
var
  bx, by: real; // vec A -> B
  cx, cy: real; // vec A -> C
  lb, lc: real; // len AB, len AC
begin
  bx := B.x - A.x;
  by := B.y - A.y;
  cx := C.x - A.x;
  cy := C.y - A.y;

  lb := sqrt(bx * bx + by * by);
  lc := sqrt(cx * cx + cy * cy);

  // normalize
  bx := xround(bx / lb, 3);
  by := xround(by / lb, 3);
  cx := xround(cx / lc, 3);
  cy := xround(cy / lc, 3);

  samevec := ((bx = cx) and (by = cy)) or ((bx = -cx) and (by = -cy));
end;

function remove(var list: TList; idx: integer): TPoint;
var
  i: integer;
begin
  remove.x := 0;
  remove.y := 0;
  if idx < length(list) then
    begin
      remove := list[idx];
      for i := idx to length(list) - 2 do
        list[i] := list[i + 1];
      setlength(list, length(list) - 1);
    end;
end;

var
  i, j, lines: integer;
  list, work: TList;
  A, B: TPoint;

begin
  while not eof(input) do
    begin
      setlength(list, length(list) + 1);
      with list[length(list) - 1] do
        readln(x, y);
    end;

  if length(list) < 3 then
    begin
      writeln('ne');
      exit;
    end;

  lines := 0;

  for i := 1 to length(list) - 1 do
    begin
      work := copy(list, 0, length(list));

      lines := 1;

      B := remove(work, i);
      A := remove(work, 0);
      for j := length(work) - 1 downto 0 do
        if samevec(A, B, work[j]) then
          remove(work, j);
      if length(work) = 0 then
        break;

      lines := 2;

      A := remove(work, 0);
      B := remove(work, 0);
      for j := length(work) - 1 downto 0 do
        if samevec(A, B, work[j]) then
          remove(work, j);
      if length(work) = 0 then
        break;

      lines := 3; // or more
    end;

  if lines = 2 then
    writeln('YES')
  else
    writeln('NO');
end.

Thanks, Ferko

APPENDED:

program line;
{$APPTYPE CONSOLE}
uses
  math,
  sysutils;

type point=record
    x,y:longint;
  end;

label x;

var
Points,otherPoints:array[0..200001] of point;
n,n2,i,j,k,i1,i2:longint;

function sameLine(A,B,C:point):boolean;
var
  ABx,ACx,ABy,ACy,k:longint;
begin
  ABx:=B.X-A.X;
  ACx:=C.X-A.X;
  ABy:=B.Y-A.Y;
  ACy:=C.Y-A.Y;
  k:=ABx*ACy-ABy*ACx;
  if (k=0) then sameLine:=true
    else sameLine:=false;
  end;


begin
readln(n);
if (n<=4) then begin
  writeln('YES');
  halt;
  end;

for i:=1 to n do readln(Points[i].x,Points[i].y);

for i:=1 to 5 do for j:=i+1 to 5 do for k:=j+1 to 5 do if not (sameLine(Points[i],Points[j],Points[k])) then begin
  i1:=i;
  i2:=j;
  goto x;
  end;

writeln('NO');
halt; 

x:
n2:=0;
for i:=1 to n do begin
  if ((i=i1) or (i=i2)) then continue;
  if not sameLine(Points[i1],Points[i2],Points[i]) then begin
    inc(n2,1);
    otherPoints[n2]:=Points[i];
    end;
  end;

if (n2<=2) then begin
  writeln('YES');
  halt;
  end;

for i:=3 to n2 do begin
  if not sameLine(otherPoints[1],otherPoints[2],otherPoints[i]) then begin
    writeln('NO');
    halt;
    end;
  end;
writeln('YES');
end.
Solution

  • I guess the answer to the Q should be devided into two parts.

    I. How to know that the given three points belong to the same line? The answer to this part of the Q was given by @Lurd and then expanded by Mbo. Let us name their solution function BelongToOneLine(Pnts: array [1..3] of TPoint): boolean; We can consider this part solved.

    II. How to decrease time consumption of the algorithm or in other words: how to avoid calling BelongToOneLilne with every possible combination of points as parameters?

    Here is the algorithm.

    1. We select 5 distinct points from the task set. 5 is enough (check combination possibilities).

    2. We find the answer to the question if there are at least three points from given five that belong to a single line.

      if No - then we do not need to iterate the remaining poins - the answer is that we require more then two lines.

      if Yes - (say poins Pt1, Pt2 and Pt3 belong to the same line and Pt4 and Pt5 - don't).

    3. Then we store the points that do not belong to the line Pt1-Pt2-Pt3 from the group-of-five in a distinct array of "outsider" points (or store their indexes in the main array). It may have Length = 0 by the end of this step. This will not affect the rest of the algo.

    4. We get the boolean result of the function BelongToOneLine([Pt1, Pt2, Pt[i]]).

      if Yes - we skip the point - it belongs to the line Pt1-Pt2-Pt3.

      if No - we store this point in the "outsiders" array.

    5. We watch the length of the OutsidersArray.

      if it is <= 2 then the answer to the whole Q is Yes, they do belong to 2 or less lines.

      if >2 then we iterate the function BelongToOneLine([OutsiderPt1, OutsiderPt2, OutsiderPt[i]]) until High(OutsiderArray) or until when OutsiderPt[i] does not belong to OutsiderPt1-OutsiderPt2 line. All points of OutsiderArray must belong to the same line otherwise the answer to the whole Q will be negative.

    Math note

    Without optimization the inerations count will be n! / ((n - k)! * k!). With the optimization it will be: 5! / ((5-3)! * 3!) + (n - 3) + P(q)outsiders * n that is about 15000 for n = 10000. Most negative count - about 20000.

    And another optimization note

    Replace declaration of TPoint with integer variables.