I want to create the following graphic:

A set of line-elements are randomly oriented in planes parallel to xy-plane. In addition, on each plane the drawed line-elements should not cross each other. Also, the magnitude of these line-elements is not constant.

How is it possible to create the figure?

Thank you very much.

  • 1
    $\begingroup$ For a start, try Line[{{RandomReal[],RandomReal[],z},{RandomReal[],RandomReal[],z}}]/.z->RandomReal[] $\endgroup$
    – LLlAMnYP
    May 19 '15 at 14:07
  • 1
    $\begingroup$ @YvesKlett non-crossing appears to be trivial enough. line1=RegionMember[Line[{{...}}],{x,y,z}];line2=RegionMember...; then Reduce[line1&&line2]. If it comes up with a solution, then they cross. $\endgroup$
    – LLlAMnYP
    May 19 '15 at 14:17
  • 1
    $\begingroup$ Do you want the the planes to be discrete,for example random integer zs? Because with float random numbers of @LLlAMnYP 's comment, it's highly, highly unlikely that two lines will end up in the same plane. $\endgroup$ May 19 '15 at 14:18
  • 2
    $\begingroup$ @YvesKlett actually the performance is surprisingly good even without coding an analytical approach: lines = Partition[RandomReal[1, {100, 2}],2]; Solve[RegionMember[Line[First@lines], {x, y}] && RegionMember[Line[#], {x, y}]] & /@ Rest[lines] // AbsoluteTiming $\endgroup$
    – LLlAMnYP
    May 19 '15 at 14:47
  • 3
    $\begingroup$ You might want to see this for a way to check line intersections. $\endgroup$ May 19 '15 at 15:27

This is not a full answer, but it, perhaps, deals with the hardest part: constructing a set of finite lines lying all in one plane, but not intersecting each other.

appendLine[list_Symbol] := (list = RandomReal[10, {1, 2, 2}])
appendLine[list_List] := Module[{newline, test = True},
  For[newline = RandomReal[10, {2, 2}], test, 
   test = ! 
         RegionMember[Line[newline], {x, y}] && 
          RegionMember[Line[#], {x, y}]] & /@ list, Length@# == 0 &], 
   newline = RandomReal[10, {2, 2}]];
  Append[list, newline]]

Run list = appendLine[list] n times to get n lines:

Do[list = appendLine[list], {n, 20}] // AbsoluteTiming
(* {4.099410, Null} *) <- (* quite slow for only 20 lines, unfortunately *)


Graphics[Line /@ list]


It's a cool model system to study, how depending on initial conditions, for example, all lines mostly orient themselves along a specific direction.

PS - a subsequent addition of 20 lines took 26 seconds, and the next line took another 1.4. Makes sense, as each new random line is more and more likely to intersect the previous ones, so more and more attempts to generate a new line need to be made, until one comes up that fits.

  • $\begingroup$ I cannot reproduce the results. Graphics[Line /@ list] results in one line. Graphics[Line /@ line] results in two lines even modifying n. $\endgroup$
    – Dimitris
    May 19 '15 at 15:28
  • $\begingroup$ Crap, typo. line->list of course. Will fix $\endgroup$
    – LLlAMnYP
    May 19 '15 at 15:29
  • $\begingroup$ @dimitris now it should work $\endgroup$
    – LLlAMnYP
    May 19 '15 at 15:31
  • $\begingroup$ For[], huh? I'd probably have used While[] instead; also, you might be interested in the undocumented function for checking line intersections. $\endgroup$ May 19 '15 at 15:33
  • $\begingroup$ Yes it works. Thanks. $\endgroup$
    – Dimitris
    May 19 '15 at 15:33

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.