Delphi 点是否最多在两条线上？

我的程序有时间问题。给定一组点，它必须说明是否所有这些点都位于两条不同的线上

我写了一段代码，它在数组中有点，并一个接一个地删除，然后尝试计算它的向量

但是这个解决方案很慢，因为它必须控制所有情况下的行。输入10000点需要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.

使用
数学；
类型
t点=记录
x、 y：真的；
结束；
TList=TPoint的数组；
函数xround（值：实数；位置：整数）：实数；
变量
马尔迪夫：真的；
开始
muldiv:=功率（10个位置）；
xround:=舍入（值*muldiv）/muldiv；
结束；
函数samevec（A，B，C:TPoint）：布尔；
变量
bx，by:real；//向量A->B
cx，cy:real；//向量A->C
lb，lc:real；//蓝AB，蓝AC
开始
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）；
//正常化
bx:=xround（bx/lb，3）；
by:=xround（by/lb，3）；
cx:=xround（cx/lc，3）；
cy:=X轮（cy/lc，3）；
samevec:=（（bx=cx）和（by=cy））或（（bx=-cx）和（by=-cy））；
结束；
函数remove（var-list:TList；idx:integer）：TPoint；
变量
i：整数；
开始
删除.x:=0；
移除。y:=0；
如果idx<长度（列表），则
开始
删除：=列表[idx]；
对于i:=idx到长度（列表）-2 do
列表[i]：=列表[i+1]；
设置长度（列表，长度（列表）-1）；
结束；
结束；
变量
i、 j，行：整数；
工作清单：TList；
A、 B:T点；
开始
而不是eof（输入）do
开始
设置长度（列表，长度（列表）+1）；
使用list[length（list）-1]do
readln（x，y）；
结束；
如果长度（列表）小于3，则
开始
书面语（'ne'）；
出口
结束；
行：=0；
对于i:=1到长度（列表）-1 do
开始
工作：=副本（列表，0，长度（列表））；
行：=1；
B:=移除（工作，i）；
A:=移除（工作，0）；
对于j:=长度（功）-1到0 do
如果samevec（A，B，work[j]），那么
移除（工作，j）；
如果长度（功）=0，则
打破
行：=2；
A:=移除（工作，0）；
B:=移除（工作，0）；
对于j:=长度（功）-1到0 do
如果samevec（A，B，work[j]），那么
移除（工作，j）；
如果长度（功）=0，则
打破
行：=3；//或更多
结束；
如果直线=2，则
writeln（'是'）
其他的
书面形式（“否”）；
结束。

谢谢，费尔科

附加：

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.

程序行；
{$APPTYPE控制台}
使用
数学，
sysutils；
类型点=记录
x、 y：长型；
结束；
标签x；
变量
点，其他点：点的数组[0..200001]；
n、 n2，i，j，k，i1，i2：长的；
函数sameLine（A，B，C：点）：布尔；
变量
ABx，ACx，ABy，ACy，k:longint；
开始
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；
如果（k=0），则sameLine:=true
else sameLine:=假；
结束；
开始
readln（n）；
如果（nA、B和C三个点位于同一条直线上，如果向量AB和AC是共线或反共线。我们可以使用向量检查共线性-它应该为零

@陆路已经描述了这种方法是评论，但作者可能错过了它

请注意，该方法不受零除法的影响-根本没有除法

 ABx := B.X - A.X;
 ACx := C.X - A.X;
 ABy := B.Y - A.Y;
 ACy := C.Y - A.Y;
 Cross := ABx * ACy - ABy * ACx;
 // for integer coordinates
 if Cross = 0 then 
    A,B,C are collinear

如果坐标是浮点，则必须考虑一些公差等级。
 //better if available:
 if Math.IsZero(Cross)
 if Math.SameValue(Cross, 0)
 //otherwise
 if Abs(Cross) <= SomeEpsilonValue 

我想问题的答案应该分为两部分

I.如何知道给定的三个点属于同一条线？
这部分问题的答案由@Lurd给出，然后由Mbo扩展。
让我们来命名他们的解决方案<代码>函数OntOnOnLeNe（PNT:ToPoT：1…3）：布尔；我们可以考虑解决这个部分。
二、 如何减少算法的时间消耗，或者换句话说：如何避免调用
BelongToOneLilne
，使用每个可能的点组合作为参数

这是算法

我们从任务集中选择5个不同的点。5个就足够了（检查组合可能性）

如果给定五个点中至少有三个点属于同一条直线，我们就能找到问题的答案

如果没有-那么我们不需要迭代剩余的点-答案是我们需要两行以上

如果是-（说点Pt1、Pt2和Pt3属于同一行，Pt4和Pt5-不要）

然后，我们将不属于五人组Pt1-Pt2-Pt3行的点存储在一个不同的“外部”点数组中（或将它们的索引存储在主数组中）。在这一步结束时，它可能具有
Length=0
。这不会影响算法的其余部分

我们得到了函数
的布尔结果，它位于一行（[Pt1，Pt2，Pt[i]]）

如果是-我们跳过该点-它属于线Pt1-Pt2-Pt3

如果否-我们将此点存储在“outsiders”数组中

我们观察太阳的长度

如果它是2，那么我们迭代函数
到一行（[OutsierPt1，OutsierPt2，OutsierPt[i]]）
直到高（OutsierArray）或直到
OutsierPt[i]
不属于OutsierPt1-OutsierPt2行。OutsierArray的所有点必须属于同一行，否则整个Q的答案将是否定的

数学笔记

如果不进行优化，惰化计数将为
n！/（（n-k）！*k！）
。
通过优化，它将是：
5！/（（5-3）！*3！）
+
（n-3）
+
P（q）局外人*n
对于n=10000，约为15000。大多数负数约为20000

还有另一个优化注释

用整数变量替换TPoint的声明。
搜索结果
来自网络的特色片段
对于n=1：需要两条线相交，因此最大相交数为0=
 if Math.IsZero(Cross / Max(ABx * ABx + ABy * ABy, ACx * ACx + ACy * ACy))