Ferko - 10 months ago 73

Pascal Question

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'

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.

Recommended for you: Get network issues from **WhatsUp Gold**. **Not end users.**

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.

We select 5

*distinct*points from the task set. 5 is enough (check combination possibilities).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).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.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.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**