2011-06-16 100 views
1

我們怎樣才能告訴Mathematica給我們一組非相交線?在這種情況下,如果兩條線有一個點(不是端點)相同,則兩條線相交。考慮這個簡單的例子: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中有效地執行此操作?這可能有助於瞭解一個算法,以查找是否two lines are intersecting

注意

這個問題是我試圖找出how to make wire frames in Mathematica with hidden line removal的第二部分。請隨時添加更多適當的標籤。

+0

我沒有MMA的在這裏,但你想要的是使用標準的線性代數來表示每一行A. {X,Y} = C,並找到地步方程都線條是真實的,使用LinearSolve。然後,檢查解決方案是否在給定的兩個線段的末端之間。如果是這樣,那就分手了。就像我對你之前問題的回答一樣,你想對Tuples [Sort [lines],{2}]這樣做。 – Verbeia 2011-06-16 08:25:00

+0

@Verbeia,什麼是元組[排列[行],{2}]'應該做的?讓我們假設'lines'是在我的文章中定義的。 – jmlopez 2011-06-16 08:58:46

+0

只有當您檢查兩行以上的行時,Tuples功能纔有必要,並且您要檢查所有可能的行對。它所做的就是創建一個列表,其中包含兩個以上元素的列表中所有可能的元素對。下面的答案是ACL的重複問題,可能比Tuples更好。 – Verbeia 2011-06-16 11:54:54

回答

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], 
     (*[email protected][{{p1,p2},{p3,p4}}]//Last,*) 
     If[ 
      [email protected][{{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}] 

產生之類的東西

enter image description here

enter image description here

(你可以四處移動定位器)。請注意,只要其中一條線是垂直的,我的split2就會被零除(這可以是固定的,但我沒有做到)。

在任何情況下,這都非常緩慢和醜陋。通過編譯和製作列表(並使用您提供的鏈接)可以使編輯速度更快,但是我目前的休息時間已經結束(或者是半小時前)。我會盡量在稍後回顧。

同時,詢問是否有任何具體的問題(例如,如果你不能看到什麼垂直線斷裂)。請注意,雖然這樣做的確如你所說,但如果你確實將地圖放在一系列的行上,你最終會得到一張不平的列表,你將不得不將其弄平。但是,這是你要求:)

+0

你能否爲了完整性而快速執行'split'?我不熟悉Mathematica中的映射函數。我很抱歉問,但是如果您使用分割功能編輯您的答案,您是否可以將其應用於具有3條相交線的示例。說:'l1 = {{-1,0},{1,0}}; l2 = {{0,-1},{0,1}}; l3 = {{-1,1},{1,1}};行= {l1,l2,l3}'。 – jmlopez 2011-06-16 09:57:10

+0

你確實回答了這個問題,但是這帶來了另一個問題。我會再考慮一下,並在編輯中發佈它,因爲再啓動另一個沒有意義。 – jmlopez 2011-06-17 02:10:13

2

爲了確定交集,你也可以做以下的參數方法,它不會遭受涉及笛卡爾方程的方法的常見問題(即除以零... ):

f[t_, l_List] := l[[1]] + t (l[[2]] - l[[1]]) 
split[l1_, l2_] := Module[{s}, 
    If[(s = [email protected] 
     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}}] 
    ]] 
+0

謝謝belisarius。這是在路口分割線的一種非常好的方式。我對效率有點擔心。這個功能必須執行很多。無論如何,我認爲我可以用你的代碼和acl提供的代碼解決問題。一旦我有更堅實的案例,我會編輯我的問題。 – jmlopez 2011-06-17 01:59:06

+0

@jmlopez在我的窮人的筆記本電腦的性能約爲每10K十字路口8秒 – 2011-06-17 02:25:38

+0

@belisarius我不認爲'減少'可以編譯,但。我給的那個很笨拙,但至少可以自動編譯爲C(經過一些按摩後) – acl 2011-06-17 09:30:02