Ferko Ferko - 8 months ago 65
Pascal Question

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?

Example:

Input:

0 1
3 4
10 11
5 0
6 2
8 6

Output: 'YES'


It looks like this:

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.

Answer Source

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.

Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download