2
$\begingroup$

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?

$\endgroup$
6
$\begingroup$

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}
  ]
 ]

enter image description here

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}}]

enter image description here

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?

$\endgroup$
  • $\begingroup$ Ah that's quite nice, thank you. I don't even need the generality you show in the last example: the region will only consist of straight lines and line will always be a single, straight segment to begin with. I was specifically hoping that there would be a way to avoid the parameterisation, but using Interpolation for that is also a good idea. :) $\endgroup$ – Martin Ender Apr 3 '16 at 14:39

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.