0
$\begingroup$

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.

Improve this question
$\endgroup$
13
  • 1
    $\begingroup$ For a start, try Line[{{RandomReal[],RandomReal[],z},{RandomReal[],RandomReal[],z}}]/.z->RandomReal[] $\endgroup$
    – LLlAMnYP
    May 19, 2015 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, 2015 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$
    – egwene sedai
    May 19, 2015 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, 2015 at 14:47
  • 3
    $\begingroup$ You might want to see this for a way to check line intersections. $\endgroup$
    – J. M.'s persistent exhaustion ♦
    May 19, 2015 at 15:27

1 Answer 1

Reset to default
2
$\begingroup$

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 = ! 
     AllTrue[Solve[
         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 *)

Display:

Graphics[Line /@ list]

20lines

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.

Improve this answer
$\endgroup$
10
  • $\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, 2015 at 15:28
  • $\begingroup$ Crap, typo. line->list of course. Will fix $\endgroup$
    – LLlAMnYP
    May 19, 2015 at 15:29
  • $\begingroup$ @dimitris now it should work $\endgroup$
    – LLlAMnYP
    May 19, 2015 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$
    – J. M.'s persistent exhaustion ♦
    May 19, 2015 at 15:33
  • $\begingroup$ Yes it works. Thanks. $\endgroup$
    – Dimitris
    May 19, 2015 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.