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
enter image description here
But I want to get something like this
enter image description here
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;
 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]]
  • 5
    $\begingroup$ I'll state the obvious: these won't be really random lines any more, if that really matters. I think the easiest would be to start from the intersection points actually, then build back the lines. Find yourself a method to pick intersection points distributed the way you want, then build back the lines from those? $\endgroup$
    – MarcoB
    Dec 15 '20 at 16:58
  • 4
    $\begingroup$ this may be useful for some part of the task: Efficient way to generate random points with a predefined lower bound on their pairwise Euclidean distance $\endgroup$
    – kglr
    Dec 15 '20 at 18:47

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.


(* 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},
   testline = genline[];
   If[Length[lines] == 
      1 || (test[Append[newlines, testline]] > mindistance),
    AppendTo[newlines, testline]; Break[]];
   , {100}]; (*do nothing after max attempts *)

(* 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 *)
  Red, PointSize[Large],

lines intersections spaced out


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]

enter image description here

  • $\begingroup$ I don't want three lines have a common intersection. $\endgroup$
    – expression
    Dec 16 '20 at 1:39
  • $\begingroup$ They do not. Look at the code. 3 points make 3 different intersections. $\endgroup$ Dec 16 '20 at 8:40
  • $\begingroup$ @expression Perhaps you should express it thus: The intersections of three lines taken pairwise should be a minimum distance apart. You will need to specify the distance. $\endgroup$
    – Michael E2
    Dec 18 '20 at 1:58

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.