点数最多两条线?

时间:2017-10-12 17:17:10

标签: delphi geometry line pascal

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

我编写了代码,它在数组中有点并逐个删除并尝试计算它的向量。

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

3 个答案:

答案 0 :(得分:1)

如果矢量AB和AC是共线的或反共线的,则A,B和C三个点位于同一直线上。我们可以使用cross product向量来检查共线性 - 它应该为零。

@LU RD已经描述过这种方法是评论,但作者可能错过了它。

请注意,方法不会被零除 - 根本没有除法。

 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 

如果坐标范围非常大,则数值误差可能很大,因此值得通过坐标差异的平方幅度来规范化公差:

 if Math.IsZero(Cross / Max(ABx * ABx + ABy * ABy, ACx * ACx + ACy * ACy))

答案 1 :(得分:0)

我想Q的答案应该分为两部分。

予。如何知道给定的三个点属于同一条线? 问题的这一部分的答案由@Lurd给出,然后由Mbo扩展。 让我们为他们的解决方案命名function BelongToOneLine(Pnts: array [1..3] of TPoint): boolean;我们可以认为这部分已经解决了。

II。如何减少算法的时间消耗,换句话说:如何避免将每个可能的点组合作为参数调用BelongToOneLilne

这是算法。

  1. 我们从任务集中选择5个不同的点。 5就够了(检查组合可能性)。

  2. 我们找到问题的答案,如果给定的五个中至少有三个点属于一行。

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

    如果是 - (假设Pt1,Pt2和Pt3属于同一条线,而Pt4和Pt5属于同一条线)。

  3. 然后我们将不属于Pt1-Pt2-Pt3线的点存储在&#34; outsider&#34;的不同数组中。点(或将其索引存储在主数组中)。在此步骤结束时,它可能会Length = 0。这不会影响算法的其余部分。

  4. 我们得到函数BelongToOneLine([Pt1, Pt2, Pt[i]])的布尔结果。

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

    如果否 - 我们将此点存储在&#34;局外人&#34;阵列

  5. 我们观察OutsidersArray的长度。

    如果是&lt; = 2 那么整个Q的答案是肯定的,它们确实属于2行或更少行。

    if&gt; 2 然后我们迭代函数BelongToOneLine([OutsiderPt1, OutsiderPt2, OutsiderPt[i]])直到High(OutsiderArray)或直到OutsiderPt[i]不属于OutsiderPt1-OutsiderPt2行。 OutsiderArray的所有点必须属于同一行,否则整个Q的答案都是负数。

  6. 数学笔记

    如果没有优化,则不合理计数将为n! / ((n - k)! * k!)。 通过优化,它将是: 对于n = 10000,5! / ((5-3)! * 3!) + (n - 3) + P(q)outsiders * n约为15000.大多数为负数 - 约为20000。

    另一个优化备注

    用整数变量替换TPoint的声明。

答案 2 :(得分:0)

搜索结果 网上精选片段 对于n = 1:您需要两条线相交,因此相交的最大数量为0。n = 2:两条不同的线将始终在一个点处相交,而与尺寸无关。 ...说明:每组2条线可以在一个点处相交。或1点是2条线的公共交点。