Intersection lines of surfaces from list contour plots

Question

I have two plots made with ListContourPlot3D. Is there a way to find the intersection curves of the surfaces represented in the two plots?

I have tried ListInterpolation and then FindRoot, but got many error messages. Before trying to fix those errors, I wanted to check if perhaps there is an easier way to do this.

Below is an example of how to generate data similar to what I have. Please note that I do not have analytic functions themselves, only their values.

table1 = Table[
   2*Log[x]*x^3 + 4*y + z - 25, {x, 0.1, 10, 0.1}, {y, 0.1, 10, 
    0.1}, {z, 0.1, 10, 0.1}];

table2 = Table[
   2*Log[1/x]*y^3 + 4*y + z + 75, {x, 0.1, 10, 0.1}, {y, 0.1, 10, 
    0.1}, {z, 0.1, 10, 0.1}];

plot1 = ListContourPlot3D[table1, Contours -> {0}, 
   DataRange -> {{0.1, 10}, {0.1, 10}, {0.1, 10}}, 
   BoundaryStyle -> Directive[Black, Thin], BaseStyle -> Opacity[0.4],
    Mesh -> None];

plot2 = ListContourPlot3D[table2, Contours -> {0}, 
   DataRange -> {{0.1, 10}, {0.1, 10}, {0.1, 10}}, 
   BoundaryStyle -> Directive[Black, Thin], BaseStyle -> Opacity[0.4],
    Mesh -> None];

Show[plot1, plot2]

You should post some example data for people to play with, but I suspect a solution would be similar to what was done here. — J. M.'s missing motivation, Mar 11 '19 at 15:28
@HenrikSchumacher I have added an example of how to generate data similar to what I have and would be grateful if you could take a look at this once again. Please note that this is just an example and that I do not have analytic functions themselves, only their values. Following your advice, I managed to extract the surfaces but could not visualize their intersection. — Prof. Smith, Mar 11 '19 at 21:25

score 3 · Answer 1 · answered Mar 12 '19 at 09:48

For some reason that I cannot understand, ListContourPlot3D perturbes the dimensions in a weird way. I prefer to use ListInterpolation in conjunction with ContourPlot3D. In this way, one can employ ImplicitRegion and DiscretizeRegion on the interpolating function generated by ListInterpolation in order to determine the intersection. This may take a bit longer that ListContourPlot3D but it results also in smoother surfaces.

g1 = ListInterpolation[table1, {{0.1, 10}, {0.1, 10}, {0.1, 10}}];
g2 = ListInterpolation[table2, {{0.1, 10}, {0.1, 10}, {0.1, 10}}];

plot1 = ContourPlot3D[
   g1[x, y, z], {x, 0.1, 10.}, {y, 0.1, 10.}, {z, 0.1, 10.}, 
   Contours -> {0}, Mesh -> None, ContourStyle -> ColorData[97][1], 
   Lighting -> "Neutral"];
plot2 = ContourPlot3D[
   g2[x, y, z], {x, 0.1, 10.}, {y, 0.1, 10.}, {z, 0.1, 10.}, 
   Contours -> {0}, Mesh -> None, ContourStyle -> ColorData[97][2], 
   Lighting -> "Neutral"];

R = ImplicitRegion[
   g1[x, y, z] == 0 && g2[x, y, z] == 0, {{x, 0.1, 10}, {y, 0.1, 10}, {z, 0.1, 10}}
   ];
S = DiscretizeRegion[R, MaxCellMeasure -> 0.025];
plot3 = Graphics3D[{Thick, 
    GraphicsComplex[MeshCoordinates[S], 
     MeshCells[S, 1, "Multicells" -> True]]}, Lighting -> "Neutral"];

Show[plot1, plot2, plot3]

I did not manage to compute the intersection of the surfaces with RegionIntersection. Apparently, RegionIntersection works only for full-dimensional regions. Very sad. — Henrik Schumacher, Mar 12 '19 at 09:52
You can get the desired coordinate system with Transpose[table1, {3, 2, 1}]. I think this difference comes from the image coordinate system v.s. the standard Cartesian coordinate system. I wonder if it makes sense to have a builtin DataReversed analog for 3D. Here's some info: https://reference.wolfram.com/language/tutorial/VolumeRenderingAndProcessing.html#1900524579 — Greg Hurst, Mar 12 '19 at 13:27

kglr · Answer 2 · 2019-03-12T13:58:24.987

Using Henrik's g1 and g2 in a single ContourPlot3D with the option BoundaryStyle (as in the link mentioned by J.M. in comments):

ContourPlot3D[{g1[x, y, z] == 0, g2[x, y, z] == 0}, 
   {x, 0.1, 5.}, {y, 0.1, 10.}, {z, 0.1, 5.}, 
   Mesh -> None, BaseStyle -> Opacity[0.4], 
   ContourStyle -> {Blue, Yellow}, Lighting -> "Neutral", 
   BoundaryStyle -> {1 -> None, 2 -> None, {1, 2} -> Opacity[1, Red]}] /. 
 Line[x_] :> Tube[x, .1]

Note: this is very slow.

Intersection lines of surfaces from list contour plots

2 Answers2