6
$\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.

Improve this question
$\endgroup$
6
  • 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$ Commented Nov 2, 2015 at 12:16
  • 4
    $\begingroup$ What do you mean by range? $\endgroup$ Commented Nov 2, 2015 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$ Commented Nov 2, 2015 at 19:15
  • $\begingroup$ see here for better (faster) ways to do the intersection check mathematica.stackexchange.com/q/51391/2079 $\endgroup$ Commented Nov 2, 2015 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$ Commented Nov 3, 2015 at 0:42

2 Answers 2

Reset to default
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

Improve this answer
$\endgroup$
9
  • $\begingroup$ (It was too long for a comment.) $\endgroup$ Commented Nov 3, 2015 at 9:28
  • $\begingroup$ Thank you very much. It is exactly what I need! $\endgroup$ Commented Nov 3, 2015 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$ Commented Nov 3, 2015 at 9:34
  • $\begingroup$ Points will only overlap if they have the same coordinates, no? $\endgroup$ Commented Nov 3, 2015 at 9:35
  • 1
    $\begingroup$ Of course! Now I understood your comment! You are absolutely right! $\endgroup$ Commented Nov 3, 2015 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.

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.