# Conversion of 3D plot to 2D Contour Plot

Is it possible for Mathematica to convert a 3D plot into a 2D contour plot without having to recompute the values for each point? I realize that looking directly down at the 3D plot will be similar to the contour plot, but I'm wondering if Mathematica is be able to take the 3D plot as input and give the 2D contour plot as output.

• Tangentially related: (55352) – Mr.Wizard Jul 24 '14 at 7:55
• Hi, I noticed that you haven't accepted either answer. Is there some aspect of your problem that neither addresses? – Michael E2 Mar 11 '15 at 15:51

Assuming that your 3D plot is in Graphics3D format, you should be able to just extract the points on the graph and use ListContourPlot.

f[x_, y_] := -E^(-(1 + x)^2 - y^2)/3 +
3*E^(-x^2 - (1 + y)^2)*(1 - x)^2 -
10*E^(-x^2 - y^2)*(x/5 - x^3 - y^5);
cp = ContourPlot[f[x, y], {x, -3, 3}, {y, -3, 3},
PlotRange -> All, PlotLabel -> "Computed from function"];
pic = Plot3D[f[x, y], {x, -3, 3}, {y, -3, 3}, PlotRange -> All,
PlotPoints -> 100];
lcp = ListContourPlot[pic[[1, 1]], PlotRange -> All,
PlotLabel -> "Computed from 3D plot"];
GraphicsRow[{lcp, cp}] • What does pic[[1,1]] do? What would be the difference between pic[[1,1]] and pic[[1,2]] (besides the fact that Mathematica doesn't like pic[[1,2]])? – user85503 Jul 24 '14 at 16:29
• @user85503 thing[[position]] represents part extraction. If you execute Short[InputForm[pic], 4], you'll see that, internally, pic has the form Graphics3D[GraphicsComplex[pts_,_],_]. Now, pic[] grabs the GraphicsComplex (since it's the first argument of Graphics3D) and pic[[1,1]] grabs the first argument of the first argument, namely the points - which is exactly what we need. – Mark McClure Jul 24 '14 at 17:18

While this is overkill, I'm just trying everything I can do with these new (in V10) and exciting Mesh and Region functions. So here we go:

f[x_, y_] := -E^(-(1 + x)^2 - y^2)/3 + 3*E^(-x^2 - (1 + y)^2)*(1 - x)^2 -
10*E^(-x^2 - y^2)*(x/5 - x^3 - y^5);

gr = Plot3D[f[x, y], {x, -3, 3}, {y, -3, 3}, PlotRange -> All, PlotPoints -> 100];


We cleverly discretize the Graphics object:

dgr = DiscretizeGraphics[Normal[gr /. {(PlotRange -> _) :>
PlotRange -> All, (Lighting -> _) :> Lighting -> Automatic}]];


And finally:

ListContourPlot[MeshCoordinates[dgr], PlotRange -> All] 