если вы предполагаете, что разделение существует, вам нужно применить его ко всем парам; они могут быть произведены
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
делится на ноль всякий раз, когда одна из линий вертикальна (это можно исправить, но я этого не сделал).
В любом случае это все очень медленно и некрасиво. Это можно было бы сделать быстрее, скомпилировав и сделав список (и используя ссылку, которую вы дали), но мой текущий перерыв на кофе закончился (или закончился полчаса назад). Я постараюсь вернуться к этому позже.
Между тем, спросите, есть ли какие-либо конкретные вопросы (например, если вы не видите, что разрывается для вертикальных линий). И обратите внимание, что хотя это делает то, что вы просите, если вы сопоставляете список строк, вы получите рваный список, который вам придется сгладить. Но это то, что вы просили :)
person
acl
schedule
16.06.2011
Tuples[Sort[lines], {2}]
? давайте предположим, чтоlines
определено, как в моем посте. - person jmlopez   schedule 16.06.2011