6
$\begingroup$

I am looking for a way to find the surface area of a contour from ContourPlot3D. Here is an example where I might like to find the area of the contour surface to G that equals -5:

G[x_, y_, z_] := 
  -2 Log[(2 + 2 Sqrt[((y)^2 + (z)^2)^2 + (-1 - Abs[x])^2] + 2  Abs[x])/
         (-2 + 2 Sqrt[((y)^2 + (z)^2)^2 + (1 - Abs[x])^2] + 2 Abs[x])] - 
   2 Log[(1. + 2 Sqrt[((x)^2 + (y)^2)^2 + (-0.5 - Abs[-0.5 + z])^2] + 
            2 Abs[-0.5 + z])/
         (-1. + 2 Sqrt[((x)^2 + (y)^2)^2 + (0.5 - Abs[-0.5` + z])^2] + 
            2 Abs[-0.5 + z])]

ContourPlot3D[G[x, y, z], {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, 
  Contours -> {-5}]

I would prefer a general method that would work even with more complicated functions than this. I don't know if there is a way to derive the area from the contour plot itself, or some other way accomplish this. Any ideas?

$\endgroup$
  • $\begingroup$ Welcome to Mathematica.SE! I hope you will become a regular contributor. To get started, 1) take the introductory Tour now, 2) when you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge, 3) remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign, and 4) give help too, by answering questions in your areas of expertise. $\endgroup$ – bbgodfrey Jun 30 '15 at 20:40
6
$\begingroup$

This problem can be solved out of the box in V10 using the ImplicitRegion function. Lets use your function G and define the bounded 3D region. We can use RegionPlot3D to visualize the object.

region = ImplicitRegion[G[x, y, z] <= -5, {x, y, z}];
RegionPlot3D[region, PlotRange -> 1.5, PlotPoints -> 60]

enter image description here

Now we will use DiscretizeRegion to form a MeshRegion. The RegionBoundary will give the 3D surface mesh from which we can easily extract the surface area using the Areaproperty.

dis = DiscretizeRegion[region,{{-1.5, 1.5},{-1.5,1.5},{-1.5, 1.5}},
AccuracyGoal -> 9,MaxCellMeasure -> {"Area" -> 0.01}];
HighlightMesh[dis, Style[1, Thin, Red]]

enter image description here

Area@RegionBoundary[dis]

18.7526

However a considerably slower Method -> "ContourPlot3D" will generate a more accurate mesh resulting in a more precise area calculation.

disFine = DiscretizeRegion[region,{{-1.5, 1.5},{-1.5, 1.5},{-1.5,1.5}},
Method -> "ContourPlot3D",AccuracyGoal -> 9,MaxCellMeasure -> {"Area" -> 0.01}]

enter image description here

Area@RegionBoundary[disFine]

18.7894

$\endgroup$
4
$\begingroup$

You can also use DiscretizeGraphics with some clever options in your ContourPlot3D. Just add the Option Lighting -> "Neutral":

gr = ContourPlot3D[G[x, y, z], {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, 
  Contours -> {-5}, Lighting -> "Neutral"] // Quiet;

Then you can compute the area with:

Area @ DiscretizeGraphics @ gr

18.8018

Here is the image from DiscretizeGraphics:

Mathematica graphics

$\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.