Geek asks and answers

Mathematica: Attaching Line Segments

This is one of my attempts to find the answer to my wireframe question in Mathematica .

Given a set of line segments, how one connects two segments that are connected AND lie on the same line. For example, consider line segments l1 = {(0,0), (1,1)}and l2 = {(1,1), (2,2)}. These two line segments can be combined into one line segment, namely l3 = {(0,0), (2,2)}. This is due to the fact that l1they l2divide the point (1,1), and the slope of each line segment is the same. Here's a visual:

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]

Output

It should be noted that in the above example, l1and l2can be combined into one line indicated by three dots, that is {{0,0},{1,1},{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 .

, , , , . :

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}
]

Ouput

Mathematica 8 3D- ( ), :

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}]

Output

90 , 12 ( ).

, . lines, , .

+3
2

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: JoinCurve, n * 2 . , , , . , , . , .

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}] .

, :

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}] ]

Step 2 , #s .

+3

, :

ClearAll[collinearQ]
collinearQ[{{{x1_, y1_}, {x2_, y2_}}, {{x3_, y3_}, {x4_, y4_}}}] := (
 (y1 - y2)*(x1 - x3) == (y1 - y3)*(x1 - x2)) && (y1 - y2)*(x1 - x4) == 
  (y1 - y4)*(x1 - x2)

ClearAll[removeExtraPts];
removeExtraPts[{{{x1_, y1_}, {x2_, y2_}}, {{x3_, y3_}, {x4_, y4_}}}] :=
If[collinearQ[{{{x1, y1}, {x2, y2}}, {{x3, y3}, {x4, y4}}}],{First@#, Last@#} &@
 SortBy[{{x1, y1}, {x2, y2}, {x3, y3}, {x4, y4}}, #[[1]] &],
    {{{x1, y1}, {x2, y2}}, {{x3, y3}, {x4, y4}}}]

lines={{{0, 0}, {1, 2}}, {{1, 1}, {2, 2}}}, {{{0, 0}, {1, 2}}, {{1, 1}, {2, 2}}}, lines2 = {{{0, 0}, {1, 2}}, {{1, 1}, {2, 2}}}, removeExtraPts[lines2] {{0, 0}, {2, 2}}.

, .. ( ).

, :

ClearAll[permsnodupsv2]
permsnodupsv2 = Last@Last@
 Reap[Do[Sow[{#[[i]], #[[j]]}], {i, 1, Length@# - 1}, {j, i + 1, 
    Length@#}]] &;

( , , , ). ,

 lines = {l1, l2, l3, l4, l5, l6, l7, l8, l9}; 
 permsnodups[lines]
 (*
 ---> {{l1, l2}, {l1, l3}, {l1, l4}, {l1, l5}, {l1, l6}, {l1, l7}, {l1, l8}, 
       {l1, l9}, {l2, l3}, {l2, l4}, {l2, l5}, {l2, l6}, {l2, l7}, 
       {l2, l8}, {l2, l9}, {l3, l4}, {l3, l5}, {l3, l6}, {l3,l7}, 
       {l3, l8}, {l3, l9}, {l4, l5}, {l4, l6}, {l4, l7}, {l4, l8}, 
       {l4, l9}, {l5, l6}, {l5, l7}, {l5, l8}, {l5, l9}, {l6, l7}, 
       {l6, l8}, {l6, l9}, {l7, l8}, {l7, l9}, {l8, l9}}
 *)

l1={{pt1,pt2},{pt3,pt4}} .., removeExtraPts , ( - Flatten[#,1]&, ) , ( @Verbeia, FixedPoint, , ). .

+1

More articles:


All Articles