4
$\begingroup$

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]

enter image description here

$\endgroup$
  • 2
    $\begingroup$ You should post some example data for people to play with, but I suspect a solution would be similar to what was done here. $\endgroup$ – J. M.'s technical difficulties Mar 11 '19 at 15:28
  • 1
    $\begingroup$ See this help page for advice on improving your question. $\endgroup$ – MarcoB Mar 11 '19 at 16:25
  • $\begingroup$ @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. $\endgroup$ – Prof. Smith Mar 11 '19 at 21:25
3
$\begingroup$

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]

enter image description here

| improve this answer | |
$\endgroup$
  • $\begingroup$ I did not manage to compute the intersection of the surfaces with RegionIntersection. Apparently, RegionIntersection works only for full-dimensional regions. Very sad. $\endgroup$ – Henrik Schumacher Mar 12 '19 at 9:52
  • 1
    $\begingroup$ 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: reference.wolfram.com/language/tutorial/… $\endgroup$ – Chip Hurst Mar 12 '19 at 13:27
3
$\begingroup$

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]

enter image description here

Note: this is very slow.

| improve this answer | |
$\endgroup$

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.