5
$\begingroup$

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]

enter image description here

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

enter image description here

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]

enter image description here

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.

$\endgroup$
  • 1
    $\begingroup$ 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] . $\endgroup$ – Dimitris Nov 2 '15 at 12:16
  • 4
    $\begingroup$ What do you mean by range? $\endgroup$ – Yves Klett Nov 2 '15 at 17:45
  • $\begingroup$ 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. $\endgroup$ – george2079 Nov 2 '15 at 19:15
  • $\begingroup$ see here for better (faster) ways to do the intersection check mathematica.stackexchange.com/q/51391/2079 $\endgroup$ – george2079 Nov 2 '15 at 19:48
  • $\begingroup$ 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. $\endgroup$ – David G. Stork Nov 3 '15 at 0:42
4
$\begingroup$
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

$\endgroup$
  • $\begingroup$ (It was too long for a comment.) $\endgroup$ – J. M. will be back soon Nov 3 '15 at 9:28
  • $\begingroup$ Thank you very much. It is exactly what I need! $\endgroup$ – Dimitris Nov 3 '15 at 9:31
  • $\begingroup$ 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! $\endgroup$ – Dimitris Nov 3 '15 at 9:34
  • $\begingroup$ Points will only overlap if they have the same coordinates, no? $\endgroup$ – J. M. will be back soon Nov 3 '15 at 9:35
  • 1
    $\begingroup$ Of course! Now I understood your comment! You are absolutely right! $\endgroup$ – Dimitris Nov 3 '15 at 9:47
0
$\begingroup$

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]

enter image description here

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

$\endgroup$

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.