wolfram-mathematica - 数学 : Joining line segments

Question

这是我试图找到问题答案的一部分 wireframes in Mathematica .

给定一组线段，如何连接两个相连且位于同一条线上的线段。例如考虑线段 l1 = {(0,0), (1,1)} 和 l2 = {(1,1), (2,2)}。这两条线段可以合并为一条线段，即l3 = {(0,0), (2,2)}。这是因为 l1 和 l2 共享点 (1,1) 并且每条线段的斜率相同。这是一个视觉效果:

l1 = JoinedCurve[{{{0, 2, 0}}}, {{{0, 0}, {1, 1}}}, CurveClosed -> {0}];
l2 = JoinedCurve[{{{0, 2, 0}}}, {{{1, 1}, {2, 2}}}, CurveClosed -> {0}];
Graphics[{Red, l1, Blue, l2}, Frame -> True]

需要注意的是，在上面的示例中，l1 和 l2 可以组合成由 3 个点指定的一行，即 {{0,0 },{1,1},{2,2}}.

这个问题的第一部分是:给定一组由 2 个点指定的线段，你如何减少这个集合以得到一个具有最少重复点的集合。考虑这个虚构的例子:

lines = {
  {{0,0}, {1,1}},
  {{3,3}, {2,2}},
  {{2,2}, {1,1}},
  {{1,1}, {0.5,0.5}},
  {{0,1}, {0,2}},
  {{2,3}, {0,1}}
}

我想要的是一个函数 say REDUCE 给我以下输出:

R = {
{{0,0}, {1,1}, {2,2}, {3,3}},
{{1,1}, {0.5,0.5}},
{{2,1}, {0,1}, {0,2}}
}

我们唯一需要的副本是 {1,1}。我这样做的方式如下:我将第一行放在 R 中然后我查看了 lines 中的下一行并注意到没有终点与R 行，所以我将这一行添加到 R。 lines 中的下一行是 {{2,2},{1,1}}，端点 {1,1} 匹配R 中的第一行，所以我将 {2,2} 附加到 R 中的行。现在我将 {{1,1}, {0.5,0.5}} 添加到 R 并且我还添加了 {{0,1}, {0,2 }}。由于 lines 中的最后一行有一个与 R 中的匹配的端点，我附加了它，所以我们有 {{2,1}, {0,1} , {0,2}}。最后，我查看了 R 中的所有行，看看是否有任何端点匹配，在本例中是行 {{3,3}, {2,2}}匹配 R 中第一行的右端点，因此我附加了 {3,3}，从而消除了 {2,2} 的需要。

这可能不是最好的方法，因为它可能不会给你最好的减少。无论如何，假设我们有这个缩减函数，那么我们可以检查是否需要所有点来描述一条线。这可以按如下方式完成:

如果我们有 3 个以上的点来描述直线，请检查前 3 个点是否共线，如果是，则移除中间的点并检查 2 个端点和一个新点的集合。如果它们不共线，则移动一个点并检查接下来的 3 个点。

我问这个问题的原因是因为我想减少描述二维图形所需的点数。尝试以下操作:

g1 = ListPlot3D[
   {{0, -1, 0}, {0, 1, 0}, {-1, 0, 1}, {1, 0, 1}, {-1, 1, 1}},
   Mesh -> {2, 2},
   Boxed -> False,
   Axes -> False,
   ViewPoint -> {2, -2, 1},
   ViewVertical -> {0, 0, 1}
]

以下 Mathematica 8 函数将 3D 对象更改为描述对象线框的线列表(一条线是 2 个点的列表):

G3TOG2INFO[g_] := Module[{obj, opt},
  obj = ImportString[ExportString[g, "PDF", Background -> None], "PDF"][[1]];
  opt = Options[obj];
  obj = Cases[obj, _JoinedCurve, \[Infinity]];
  obj = Map[#[[2]][[1]] &, obj];
  {obj, opt}
]

请注意，在 Mathematica 7 中，我们必须将 _JoinedCurve 替换为 _Line。将函数应用于 g1 我们得到

{lines, opt} = G3TOG2INFO[g1];
Row[{Graphics[Map[Line[#] &, lines], opt], Length@lines}]

那里有 90 条线段，但我们只需要 12 条(如果我在计算直线时没有犯错的话)。

所以你遇到了挑战。我们如何操作线以获得描述图形所需的最少信息量。

Answer 1

第 1 步是查找这些线是否在同一投影上。如果第一条线的斜率等于从第一条线的倒数第二个点到第二条线的第二个点的构造线段的斜率，则为真。

我的工作机器上没有 Mathematica，所以我无法对此进行测试(可能存在语法错误)，但像下面这样的东西应该可以工作:

(( #2[[2,2]]-#1[[-2,2]])/(#2[[2,1]]-#1[[-2,1]])) ==
(( #1[[-1,2]]-#1[[-2,2]])/(#1[[-1,1]]-#1[[-2,1]])) & 
 @@@ (Transpose[{Most[lines],Rest[lines]}])

本质上，这一切所做的就是测试第一行的“上升超过运行”是否等于连接线段的“上升超过运行”。

我假设 :lines: 不是 JoinedCurve 元素的列表，而是 n*2 个点列表的简单列表。我还假设定义每条线段的点对按规范顺序排列，这些点在 x 方向上按升序排列。即第一个点的第一个元素的值小于第二个点的第一个元素的值。如果不是，请先对它们进行排序。

第 2 步实际上是连接点。这将应用步骤 1 中的测试，然后将两条线替换为一条连接线。您可以将其包装在 FixedPoint 中以连接同一投影中的所有线。

If[(( #2[[2,2]]-#1[[-2,2]])/(#2[[2,1]]-#1[[-2,1]])) ==
(( #1[[-1,2]]-#1[[-2,2]])/(#1[[-1,1]]-#1[[-2,1]])), {#1[[-2]],#2[[2]]}] & 
 @@@ (Transpose[{Most[lines],Rest[lines]}])

这一切都假定您要比较的线对在列表中是相邻的。如果它们可能是您集合中的任何一行，那么您首先需要生成一个列表，其中包含要比较的所有可能的行对，例如使用 Tuples[listOfLines, {2}]，而不是上面的 Transpose 函数。

好的，把这些放在一起:

f = If[(( #2[[2,2]]-#1[[-2,2]])/(#2[[2,1]]-#1[[-2,1]])) ==
(( #1[[-1,2]]-#1[[-2,2]])/(#1[[-1,1]]-#1[[-2,1]])), {#1[[-2]],#2[[2]]}] & ;
FixedPoint[f @@@ #, Tuples[Sort[listOfLines],{2}] ]

我已将第 2 步测试和替换函数分解为一个命名的纯函数，这样 #s 就不会混淆。