我的程序有时间问题。给定一组点,它必须说所有这些点是否都位于两条不同的线上。
我编写了代码,该代码在数组中具有点,并一一删除,然后尝试计算它的向量。
但是这种解决方案很慢,因为它必须控制所有行情况。输入10,000点,将花费10秒钟以上。
有人可以告诉我,这里是否有更好的解决方案?
我在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.
谢谢,Ferko
附加:
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.
最佳答案
我想对Q的回答应该分为两部分。
I.如何知道给定的三个点属于同一条线?
Q部分的答案由@Lurd给出,然后由Mbo扩展。
让我们将他们的解决方案命名为function BelongToOneLine(Pnts: array [1..3] of TPoint): boolean;
我们可以考虑解决这一部分。
二。如何减少算法的时间消耗,或者换句话说:如何避免以所有可能的点组合作为参数调用BelongToOneLilne
?
这是算法。
我们从任务集中选择5个不同的点。 5就足够了(检查组合可能性)。
如果给定的五个点中至少有三个点属于一条直线,则可以找到问题的答案。
如果为“否”,那么我们不需要迭代其余的“点”。答案是,我们需要多于两行。
如果是-(说点Pt1,Pt2和Pt3属于同一行,而Pt4和Pt5-则不)。
然后,将五组中不属于线Pt1-Pt2-Pt3的点存储在不同的“外部”点数组中(或将其索引存储在主数组中)。在此步骤结束时,它可能具有Length = 0
。这不会影响其他算法。
我们得到函数BelongToOneLine([Pt1, Pt2, Pt[i]])
的布尔结果。
如果是-我们跳过该点-它属于线Pt1-Pt2-Pt3。
如果否-我们将此点存储在“外部”数组中。
我们观看了OutsidersArray的长度。
如果
如果> 2,则迭代函数BelongToOneLine([OutsiderPt1, OutsiderPt2, OutsiderPt[i]])
直到High(OutsiderArray)或直到OutsiderPt[i]
不属于OutsiderPt1-OutsiderPt2行。 OutsiderArray的所有点都必须属于同一行,否则整个Q的答案将为负。
数学笔记
如果不优化,迭代次数将为n! / ((n - k)! * k!)
。
通过优化,它将是:5! / ((5-3)! * 3!)
+ (n - 3)
+ P(q)outsiders * n
对于n = 10000约为15000。最大负数-约为20000。
还有另一个优化说明
用整数变量替换TPoint的声明。