Generate random lines that don't be too crowded between the intersections

Question

It's easy to generate random lines, such as this n = 8; lines = InfiniteLine /@ RandomReal[1, {n, 2, 2}]; points = RegionIntersection @@@ Subsets[lines, {2}]; Graphics[{lines, Red, points}, PlotRangePadding -> Scaled[.2]] If there are more lines, some of the points of intersection between them will be very close But I want to get something like this This means making the distance between the intersections and and the angle between the lines as uniform as possible. I thought of a brute force method, very slow, is there a more efficient method? n = 6; (Label["begin"]; lines = InfiniteLine /@ RandomReal[{-1, 1}, {n, 2, 2}]; intersectionPts = First /@ RegionIntersection @@@ Subsets[lines, {2}]; If[! AllTrue[EuclideanDistance @@@ Subsets[intersectionPts, {2}], 0.2 < # < n &], Goto["begin"]]) EuclideanDistance @@@ Subsets[intersectionPts, {2}] // MinMax Graphics[{lines, Red, Point@intersectionPts}, PlotRange -> All, PlotRangePadding -> Scaled[.1]]

Daniel Huber · Answer

We could e.g. create a grid of n x n points:
n = 10; (* grid length*)
pts = Flatten[Table[{x, y}, {x, n}, {y, n}], 1];

And then choose from this grid at random m tripplets of crossing points:
m = 5; (* # of tripplets *)
int = Table[RandomSample[pts, 3], m]

And finally draw lines through all the crossing points:
Graphics[{InfiniteLine[##[[1 ;; 2]]], InfiniteLine[##[[2 ;; 3]]], 
    InfiniteLine[##[[{1, 3}]]]} & /@ int]

flinty · Answer

You could try to add lines as you go, rejecting them if they create any intersections that are too close together then trying again, or adding them to the list if they meet a minimum distance criterion. This isn't always guaranteed to work as it's possible there are too many crowded lines early on, but in that case you can always change the seed until you get a good configuration.
SeedRandom[1234];

(* return the minimum distance between any intersection points *)
test[lines_] :=
 Min[EuclideanDistance @@@ 
   Subsets[Graphics`Mesh`FindIntersections@lines, {2}]]

(* generate a random line *)
genline[] := InfiniteLine@RandomReal[{-1, 1}, {2, 2}]

(* try to generate a new line. Accept it into the list if min test passes *)
addnewline[lines_, mindistance_] := 
 Module[{newlines = lines, testline},
  Do[
   testline = genline[];
   If[Length[lines] == 
      1 || (test[Append[newlines, testline]] > mindistance),
    AppendTo[newlines, testline]; Break[]];
   , {100}]; (*do nothing after max attempts *)
  Return[newlines] 
  ]

(* repeatedly add new lines to list until we have n of them. Try at most 1000 iterations *)
n = 6;
mind = 0.6;
lines = NestWhile[addnewline[#, mind] &, {genline[]}, Length[#] < n &,
    1, 1000];

(* draw the lines *)
Graphics[{
  lines,
  Red, PointSize[Large],
  Point@Graphics`Mesh`FindIntersections@lines
  }]

Generate random lines that don't be too crowded between the intersections

2 Answers

Add your own answers!

Ask a Question