1

我们如何告诉Mathematica给我们一组不相交的线？在这种情况下，如果两条线有一个共同点（不是端点），则它们相交。考虑这个简单的案例：

l1 = {{-1, 0}, {1, 0}};
l2 = {{0, -1}, {0, 1}};
lines = {l1, l2};

这个想法是创建一个函数，给定一组线，返回一组不相交的线。如果存在这样的功能，split那么输出

split[lines]

将会

{
 {{-1, 0}, {0,0}},
 {{ 0, 0}, {1,0}}, 
 {{ 0,-1}, {0,0}}, 
 {{ 0, 0}, {0,1}}
}

检测到的函数{0,0}是集合中两条线之间的交点，为了获得不相交的线，它打破了交点处的线段，从而产生了另外 2 条线。如果原始输入包含更多行，则此过程会变得更加复杂。有谁知道如何在不使用循环的情况下在Mathematica中有效地做到这一点？了解查找两条线是否相交的算法可能会有所帮助。

笔记

这个问题是我试图找出如何在Mathematica中制作带有隐藏线移除的线框的第二部分。请随意添加更多合适的标签。

4

2 回答 2

3

如果您假设存在拆分，则需要将其应用于所有对；这些可能由

ClearAll[permsnodups];
permsnodups[lp_] := DeleteDuplicates[Permutations[lp, {2}],
   ((#1[[1]] == #2[[1]]) &&(#1[[2]] == #2[[2]]) || 
   (#1[[1]] == #2[[2]]) && (#1[[2]] == #2[[1]])) &]

这样做：permsnodups[{a, b, c, d}]给{{a, b}, {a, c}, {a, d}, {b, c}, {b, d}, {c, d}}，你可以在其上映射你的split函数（即这些都是对的，确保如果{a,b}有，那么{b,a}从那时起你就没有理由做了两倍的工作——这就像在做 $\sum_{i ,j>i}$ 而不是 $\sum_{i,j}$)。

编辑：这是一个实现split（我被困在半小时左右无法访问互联网，所以手工计算出相关的方程式，这不是基于您提供的链接，也不是优化或漂亮）：

ClearAll[split2]
split2[{{ai_, bi_}, {ci_, di_}}] := Module[
{g1, g2, a, b, c, d, x0, y0, alpha, beta},
(*make sure that a is to the left of b*)

If[ai[[1]] > bi[[1]], {a, b} = {bi, ai}, {a, b} = {ai, bi}];
If[ci[[1]] > di[[1]], {c, d} = {di, ci}, {c, d} = {ci, di}];
g1 = (b[[2]] - a[[2]])/(b[[1]] - a[[1]]);
g2 = (d[[2]] - c[[2]])/(d[[1]] - c[[1]]);
If[g2 \[Equal] g1,
    {{a, b}, {c, d}},(*they're parallel*)

alpha = a[[2]] - g1*a[[1]];
    beta = c[[2]] - g2*c[[1]];
    x0 = (alpha - beta)/(g2 - g1);(*intersection x*)

If[(a[[1]] < x0 < b[[1]]) && (c[[1]] < x0 < 
   d[[1]]),(*they do intersect*)
            y0 = alpha + g1*x0;
            {{a, #}, {#, b}, {c, #}, {#, d}} &@{x0, y0},
            {{a, b}, {c, d}}(*they don't intersect after all*)]]]

（实际上它非常缓慢和丑陋）。无论如何，你可以看到它是这样工作的：

Manipulate[
Grid[{{Graphics[{Line[{p1, p2}, VertexColors \[Rule] {Red, Green}], 
  Line[{p3, p4}]},
        PlotRange \[Rule] 3, Axes \[Rule] True],
        (*Reap@split2[{{p1,p2},{p3,p4}}]//Last,*)
        If[
            Length@split2[{{p1, p2}, {p3, p4}}] \[Equal] 2,
            "not intersecting",
            "intersecting"]}}],
{{p1, {0, 1}}, Locator}, {{p2, {1, 1}}, Locator},
{{p3, {2.3, -.1}}, Locator}, {{p4, {2, 1}}, Locator}]

这会产生类似的东西

在此处输入图像描述

和

在此处输入图像描述

（您可以移动定位器）。请注意，只要其中一条线是垂直的，我的split2除以零（这可以修复，但我没有这样做）。

无论如何，这一切都非常缓慢和丑陋。通过编译和使其可列出（并使用您提供的链接）可以使其更快，但我目前的咖啡休息时间已经结束（或半小时前）。我稍后会尝试回到这个问题。

同时，一定要问是否有任何具体问题（例如，如果你看不到垂直线的断点）。请注意，虽然这可以满足您的要求，但如果您在行列表上进行映射，您最终会得到一个参差不齐的列表，您必须将其展平。但是，这就是你要求的:)

于 2011-06-16T09:45:43.957 回答
2

为了确定交点，您还可以执行以下参数化方法，该方法不会遇到涉及笛卡尔方程的方法的常见问题（即除以零......）：

f[t_, l_List] := l[[1]] + t (l[[2]] - l[[1]])
split[l1_, l2_] := Module[{s},
  If[(s = ToRules@
       Reduce[f[t1, l1]==f[t2, l2] && 0 <t2< 1 && 0 <t1< 1, {t1,t2},Reals]) =={},
   Return[{l1, l2}],
   Return[{{f[0, l1], f[t1, l1] /. s}, {f[1, l1], f[t1, l1] /. s},
           {f[0, l2], f[t2, l2] /. s}, {f[1, l2], f[t2, l2] /. s}}]
   ]]
于 2011-06-17T00:23:11.323 回答