Partition a line around intersections

Question

I've got a bunch of lines (ideally in a single Region) as well as a single new line, e.g.:

region = RegionUnion @@ Line /@ Table[{{x, -1}, {x, 1}}, {x, 3}]
line = Line @ {{0, 0}, {4, 0}}

I want to find all the intersections between region and line and want to use those to partition line into a bunch of sub-lines that don't cross any of the intersections. That is, for the above example I want the lines:

Line /@ { {{0,0}, {1,0}},
          {{1,0}, {2,0}},
          {{2,0}, {3,0}},
          {{3,0}, {4,0}} }

I also need these lines in order (having the order reversed is fine, I just want to be able to find the first and last segment easily).

Of course I could implement this myself by solving a bunch of simple equations, but I was hoping Mathematica's myriad of built-ins allow for a simpler/more idiomatic solution (the issue with solving this based on line intersection is that I have to test for each line in region separately, whereas the Region* functions can treat the entire region as a single entity). I tried working with RegionDifference[line, region], but Mathematica isn't able to express the resulting segments as new Line objects (presumably, because RegionDifference results in open sets and Line represents a closed set, which I'd be fine with).

Is there any decent way to solve this with a handful of built-ins based on regions, or will I have to roll my own solution solving line equations?

Answer 1

You're correct in that MMA provides a simpler way to find the intersections:

intersections = Solve[{x, y} \[Element] region && {x, y} \[Element] line, {x, y}]

{{x -> 1, y -> 0}, {x -> 2, y -> 0}, {x -> 3, y -> 0}}

Dividing up your line is then something of another problem in itself as many factor come into play: Is your line one single straight line? Does it intersect lines in your region more than once? etc etc, So the approach you take will differ depending on what constraints you have.

The following should be a fairly general solution based on parameterising the line and finding the values of the parameter where the intersects occur.

Parameterise[line_] := Module[{linePts, nPts},
  linePts = line[[1]];
  nPts = Length[linePts];

  Interpolation[Transpose[{Rescale@Range[nPts], linePts}], InterpolationOrder -> 1]
  ]

pLine = Parameterise[line];

tab = Table[{u, pLine[u]}, {u, 0, 1, 1/100.}];

intersects = Nearest[tab[[;; , 2]] -> tab[[;; , 1]], #] & /@ intersections[[;; , ;; , 2]];

p = Partition[Join[{0}, Sort[Flatten[intersects]], {1}], 2, 1]

{{0, 0.25}, {0.25, 0.5}, {0.5, 0.75}, {0.75, 1}}

Show[
 DiscretizeRegion[region],
 Table[
  ParametricPlot[pLine[u], {u, p[[i, 1]], p[[i, 2]]}, 
   PlotStyle -> ColorData[97][i]],
  {i, 1, Length@p}
  ]
 ]

To show its versatility:

line = Line@Transpose[{RandomReal[{0, 4}, {4}], RandomReal[{-1, 1}, {4}]}]

Line[{{2.17744, -0.0514017}, {3.69122, -0.940829}, {0.786582, -0.670897}, {1.24424, -0.326177}}]

If I could find a way to invert the pLines function I could do away with the inelegant tab and Nearest components and directly find u when f[u] = {x,y}. Any pointers?