Generate random non-intersecting lines inside a square

Question

EDIT

I have the following code which generates (pseudo-) randomly oriented and distributed but not intersecting lines. In fact, the code is from the reply I got here:

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

SeedRandom[1247]
list =.
Do[list = appendLine[list], {n, 15}] 
ln1 = (Line /@ list) /. 
   Line[a_] :> {Thick, If[RandomInteger[{1, 2}] == 1, Dashed], 
     Line[a]};
g1 = Graphics[ln1]

The original question had to do with SeedRandom but it was too trivial and I found the workaround on my own. Then I modified my question to something less trivial. I apologize for any confusion this may have caused!

My question restated (I hope) with better wording is:

How is it possible to modify the appendLine user-defined function in order to get exactly the same distribution of lines but in another "square" of side 10? such as

EDIT 2

Thanks to the smart code of J.M. I am almost there. Unfortunately, I realized that it does not give me exactly what I want. The mistake is mine of course and not of J.M. who replied me to what I asked. I do not know if I have to ask a new thread. In order (I hope!) to be more specific let me create a real example.

BlockRandom[SeedRandom[143, Method -> "MersenneTwister"];
  dom = {0, 10}; n = 20;
  lines = {RandomReal[dom, {2, 2}]}; k = 1;
  While[k < n, test = RandomReal[dom, {2, 2}];
   If[FindIntersections[{Line[lines], Line[test]}] === {}, k++; 
    AppendTo[lines, test]]];
  gLines1 = 
   Graphics[{RandomChoice[{Directive[Thick, Dashed], Thick}], 
       Line[#]} & /@ lines, Frame -> True, PlotRange -> {dom, dom}]];

BlockRandom[SeedRandom[143, Method -> "MersenneTwister"];
  dom = {12.5, 22.5}; n = 20;
  lines = {RandomReal[dom, {2, 2}]}; k = 1;
  While[k < n, test = RandomReal[dom, {2, 2}];
   If[FindIntersections[{Line[lines], Line[test]}] === {}, k++; 
    AppendTo[lines, test]]];
  gLines2 = 
   Graphics[{RandomChoice[{Directive[Thick, Dashed], Thick}], 
       Line[#]} & /@ lines, Frame -> True, PlotRange -> {dom, dom}]];

BlockRandom[SeedRandom[143, Method -> "MersenneTwister"];
  dom = {-12.5, -2.5}; n = 20;
  lines = {RandomReal[dom, {2, 2}]}; k = 1;
  While[k < n, test = RandomReal[dom, {2, 2}];
   If[FindIntersections[{Line[lines], Line[test]}] === {}, k++; 
    AppendTo[lines, test]]];
  gLines3 = 
   Graphics[{RandomChoice[{Directive[Thick, Dashed], Thick}], 
       Line[#]} & /@ lines, Frame -> True, PlotRange -> {dom, dom}]];

gRecA = Graphics[{FaceForm[GrayLevel[1]], 
    EdgeForm[Directive[Thick, Black]], 
    Rectangle[{-12.5, 0}, {-2.5, 10}]}];
gRecB = Graphics[{FaceForm[GrayLevel[0.7]], 
    EdgeForm[Directive[Thick, Black]], 
    Rectangle[{-12.5, -5}, {-2.5, -15}]}];
gRecC = Graphics[{FaceForm[GrayLevel[1]], 
    EdgeForm[Directive[Dotted, Black]], Rectangle[{0, 0}, {10, 10}]}];
gRecD = Graphics[{FaceForm[GrayLevel[0.7]], 
    EdgeForm[Directive[Thick, Black]], 
    Rectangle[{12.5, 0}, {22.5, 10}]}];
plusequal = 
  Graphics[{Line[{{-1.5, 5}, {-0.5, 5}}], 
    Line[{{-1.0, 5.6}, {-1.0, 4.4}}], Line[{{-1.5, 5}, {-0.5, 5}}], 
    Line[{{10.5, 5.2}, {11.5, 5.2}}], 
    Line[{{10.5, 4.8}, {11.5, 4.8}}]}];
Show[{gRecA, gRecB, gRecC, gRecD, gLines1, plusequal, gLines2, 
  gLines3}, PlotRange -> All, Frame -> True]

We see that we got the same distribution (as I originally wanted) of non-intersecting lines and in the same x-domain as that of the squares but there was also the unpleasant side-effect of y-translation. Once again the mistake was mine. I want the randomly distributed lines to fit inside these squares.

So, the whole idea is given a square of side 10 like Graphics[{FaceForm[GrayLevel[0.7]], EdgeForm[Directive[Thick, Black]], Rectangle[{-12.5, -5}, {-2.5, -15}]}] "fit" this distribution of lines inside it.

Oh! It was very easy. Add SeedRandom before the code. SeedRandom[1234]; list =. Do[list = appendLine[list], {n, 15}] // AbsoluteTiming ln1 = (Line /@ list) /. Line[a_] :> {Thick, If[RandomInteger[{1, 2}] == 1, Dashed], Line[a]}; g1 = Graphics[ln1] . — Dimitris, Nov 02 '15 at 12:16
this in unclear what you are asking or what the solution in the comment does. If you no longer seek an answer you probably should just delete the question. — george2079, Nov 02 '15 at 19:15
see here for better (faster) ways to do the intersection check http://mathematica.stackexchange.com/q/51391/2079 — george2079, Nov 02 '15 at 19:48
As long as you (for some reason) want to have some lines solid and some lines dashed, change If[RandomInteger[{1, 2}] == 1 to If[RandomInteger[1] == 0. A teeny bit faster. — David G. Stork, Nov 03 '15 at 00:42
My comment corresponded to a previous version of the question. I will edit again the question to make it clearer. Thanks for your comments and suggestions. — Dimitris, Nov 03 '15 at 08:23

score 4 · Accepted Answer · answered Nov 03 '15 at 09:26

4

Graphics`Mesh`MeshInit[];
BlockRandom[SeedRandom[143, Method -> "MersenneTwister"];
            dom = {10, 20}; n = 20;
            lines = {RandomReal[dom, {2, 2}]}; k = 1;
            While[k < n,
                  test = RandomReal[dom, {2, 2}];
                  If[FindIntersections[{Line[lines], Line[test]}] === {},
                     k++; AppendTo[lines, test]]];
            Graphics[{RandomChoice[{Directive[Thick, Dashed], Thick}], Line[#]} &
                      /@ lines, Frame -> True, PlotRange -> {dom, dom}]]

bunch of lines

answered Nov 03 '15 at 09:26

J. M.'s missing motivation

124,525
11
401
574

(It was too long for a comment.) – J. M.'s missing motivation Nov 03 '15 at 09:28
Thank you very much. It is exactly what I need! – Dimitris Nov 03 '15 at 09:31
Because it is closely related I thought it is not a good idea to start a new post. So, if instead of lines we have points (randomly distributed but no overlapping) how your code should be modified? Thanks in advance! – Dimitris Nov 03 '15 at 09:34
Points will only overlap if they have the same coordinates, no? – J. M.'s missing motivation Nov 03 '15 at 09:35
If I understand correct what do you mean, no. – Dimitris Nov 03 '15 at 09:39
I guess sth like GraphicsMeshMeshInit[]; BlockRandom[SeedRandom[143, Method -> "MersenneTwister"]; dom = {0, 10}; n = 20; points = {RandomReal[dom, {2}]}; k = 1; While[k < n, test = RandomReal[dom, {2}]; If[FindIntersections[{Point[points], Point[test]}] === {}, k++; AppendTo[points, test]]]; Graphics[{RandomChoice[{Directive[Blue, Red], Blue}], Point[#]} & /@ points, Frame -> True, PlotRange -> {dom, dom}]] does what I want. J.M. thank you one more time! – Dimitris Nov 03 '15 at 09:39
FindIntersections[] is not needed for points. If RandomReal[dom, {n, 2}] has no identical elements (and that is quite likely), then you have your n points. – J. M.'s missing motivation Nov 03 '15 at 09:44
1

Of course! Now I understood your comment! You are absolutely right! – Dimitris Nov 03 '15 at 09:47
I upgraged my question. Your code is very helpful but still it cannot produce what I need. Once more time the mistake is of course mine and not yours. You smartly replied to what I asked. – Dimitris Nov 03 '15 at 11:03

score 0 · Answer 2 · answered Nov 03 '15 at 12:37

Actually, given the code of J.M. it was easier than I thought. I post the complete workaround as an asnwer. Of course the credit goes to J.M. and that's why I accept his answer.

BlockRandom[SeedRandom[143, Method -> "MersenneTwister"];
  dom = {0, 10}; n = 20;
  lines = {RandomReal[dom, {2, 2}]}; k = 1;
  While[k < n, test = RandomReal[dom, {2, 2}];
   If[FindIntersections[{Line[lines], Line[test]}] === {}, k++; 
    AppendTo[lines, test]]];
  gLines1 = 
   Graphics[{RandomChoice[{Directive[Thick, Dashed], Thick}], 
       Line[#]} & /@ lines, Frame -> True, PlotRange -> {dom, dom}]];
(*generates lines in the domain {{0,10},{0,10}}*)

BlockRandom[SeedRandom[143, Method -> "MersenneTwister"];
  dom = {12.5, 22.5}; n = 20;
  lines = {RandomReal[dom, {2, 2}]}; k = 1;
  While[k < n, test = RandomReal[dom, {2, 2}];
   If[FindIntersections[{Line[lines], Line[test]}] === {}, k++; 
    AppendTo[lines, test]]];
  gLines2 = 
   Graphics[{RandomChoice[{Directive[Thick, Dashed], Thick}], 
       Line[#]} & /@ lines, Frame -> True]]; 
(*generates lines in the domain
{{12.5,12.5},{12.5,12.5}}*)
     gLines2 = 
          gLines2 /. 
           Line[{{a_, b_}, {c_, d_}}] :> Line[{{a, b - 12.5}, {c, d - 12.5}}];
(*modify the domain; parallel vertical translation of the lines*)

BlockRandom[SeedRandom[143, Method -> "MersenneTwister"];
  dom = {-12.5, -2.5}; n = 20;
  lines = {RandomReal[dom, {2, 2}]}; k = 1;
  While[k < n, test = RandomReal[dom, {2, 2}];
   If[FindIntersections[{Line[lines], Line[test]}] === {}, k++; 
    AppendTo[lines, test]]];
  gLines3 = 
   Graphics[{RandomChoice[{Directive[Thick, Dashed], Thick}], 
       Line[#]} & /@ lines]];
gLines3 = 
  gLines3 /. 
   Line[{{a_, b_}, {c_, d_}}] :> Line[{{a, b - 2.5}, {c, d - 2.5}}];

and the final graphic...

gRecA = Graphics[{FaceForm[GrayLevel[1]], 
    EdgeForm[Directive[Thick, Black]], 
    Rectangle[{-12.5, 0}, {-2.5, 10}]}];
gRecB = Graphics[{FaceForm[GrayLevel[0.7]], 
    EdgeForm[Directive[Thick, Black]], 
    Rectangle[{-12.5, -5}, {-2.5, -15}]}];
gRecC = Graphics[{FaceForm[GrayLevel[1]], 
    EdgeForm[Directive[Dotted, Black]], Rectangle[{0, 0}, {10, 10}]}];
gRecD = Graphics[{FaceForm[GrayLevel[0.7]], 
    EdgeForm[Directive[Thick, Black]], 
    Rectangle[{12.5, 0}, {22.5, 10}]}];
plusequal = 
  Graphics[{Line[{{-1.5, 5}, {-0.5, 5}}], 
    Line[{{-1.0, 5.6}, {-1.0, 4.4}}], Line[{{-1.5, 5}, {-0.5, 5}}], 
    Line[{{10.5, 5.2}, {11.5, 5.2}}], 
    Line[{{10.5, 4.8}, {11.5, 4.8}}]}];
Show[{gRecA, gRecB, gRecC, gRecD, gLines1, plusequal, gLines2, 
  gLines3}, PlotRange -> All, Frame -> True]

I guess there must be more clever ways to create this graphic.

Generate random non-intersecting lines inside a square

2 Answers2

Linked