Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I would like to combine a 3-dimensional graph of a function with its 2-dimensional contour-plot underneath it in a professional way. But I have no idea how to start.

I have a three of these I would like to make, so I don't need a fully automated function that does this. A giant block of code would be just fine.

The two plots I would like to have combined are:

potential1 = 
  Plot3D[-3600. h^2 + 0.02974 h^4 - 5391.90 s^2 + 0.275 h^2 s^2 + 0.125 s^4, 
    {h, -400, 400}, {s, -300, 300}, PlotRange -> {-1.4*10^8, 2*10^7}, 
    ClippingStyle -> None, MeshFunctions -> {#3 &}, Mesh -> 10,
    MeshStyle -> {AbsoluteThickness[1], Blue}, Lighting -> "Neutral",
    MeshShading -> {{Opacity[.4], Blue}, {Opacity[.2], Blue}}, Boxed -> False,
    Axes -> False]

and

contourPotentialPlot1 = 
  ContourPlot[-3600. h^2 + 0.02974 h^4 - 5391.90 s^2 + 0.275 h^2 s^2 + 0.125 s^4, 
   {h, -400, 400}, {s, -300, 300}, PlotRange -> {-1.4*10^8, 2*10^7},
   Contours -> 10, ContourStyle -> {{AbsoluteThickness[1], Blue}}, Axes -> False, 
   PlotPoints -> 30]

These two plots look like:

The 3-D plot The contour plot

I would also love it if I could get 'grids' on the sides of the box like in http://en.wikipedia.org/wiki/File:GammaAbsSmallPlot.png

share|improve this question
    
For the grids look up FaceGrids in the docs. –  kguler Nov 19 '12 at 1:43
    
Looks like you want something like this: mathematica.stackexchange.com/q/7772/5 (see Jens' answer) –  rm -rf Nov 19 '12 at 1:46

2 Answers 2

up vote 29 down vote accepted

Strategy is simple texture map 2D plot on a rectangle under your 3D surface. I took a liberty with some styling that I like - you can always come back to yours.

contourPotentialPlot1 = ContourPlot[-3600. h^2 + 0.02974 h^4 - 5391.90 s^2 + 
   0.275 h^2 s^2 + 0.125 s^4, {h, -400, 400}, {s, -300, 300}, 
 PlotRange -> {-1.4*10^8, 2*10^7}, Contours -> 15, Axes -> False, 
 PlotPoints -> 30, PlotRangePadding -> 0, Frame -> False, ColorFunction -> "DarkRainbow"];

potential1 = Plot3D[-3600. h^2 + 0.02974 h^4 - 5391.90 s^2 + 0.275 h^2 s^2 + 
    0.125 s^4, {h, -400, 400}, {s, -300, 300}, 
   PlotRange -> {-1.4*10^8, 2*10^7}, ClippingStyle -> None, 
   MeshFunctions -> {#3 &}, Mesh -> 15, MeshStyle -> Opacity[.5], 
   MeshShading -> {{Opacity[.3], Blue}, {Opacity[.8], Orange}}, Lighting -> "Neutral"];

level = -1.2 10^8; gr = Graphics3D[{Texture[contourPotentialPlot1], EdgeForm[], 
Polygon[{{-400, -300, level}, {400, -300, level}, {400, 300, level}, {-400, 300, level}}, 
VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}, Lighting -> "Neutral"];

Show[potential1, gr, PlotRange -> All, BoxRatios -> {1, 1, .6}, FaceGrids -> {Back, Left}]

enter image description here

You can see I used PlotRangePadding -> 0 option in ContourPlot. It is to remove white space around the graphics to make texture mapping more precise. If you need utmost precision you can take another path. Extract graphics primitives from ContourPlot and make them 3D graphics primitives. If you need to color the bare contours - you could replace Line by Polygon and do some tricks with FaceForm based on a contour location.

level = -1.2 10^8;
pts = Append[#, level] & /@ contourPotentialPlot1[[1, 1]];
cts = Cases[contourPotentialPlot1, Line[l_], Infinity];
cts3D = Graphics3D[GraphicsComplex[pts, {Opacity[.5], cts}]];

Show[potential1, cts3D, PlotRange -> All, BoxRatios -> {1, 1, .6}, 
 FaceGrids -> {Bottom, Back, Left}]

enter image description here

share|improve this answer
    
+1 for awesome styling. –  Arcotick Jan 20 at 2:43

A simpler version but not as nice as Vitally's is this:

potential1 /. 
 Graphics3D[gr_, opts___] :> 
  Graphics3D[{gr, Scale[gr, {1, 1, 1/100}, {0, 0, -2 10^8}]}, 
   PlotRange -> All, opts]

enter image description here

This can also be "projected" onto the other sides.

potential1 /. 
 Graphics3D[gr_, opts___] :> 
  Graphics3D[{gr, Scale[gr, {1, 1, 1/100}, {0, 0, -2 10^8}], 
    Scale[gr, {1/100, 1, 1}, {-400, 0, 0}]}, PlotRange -> All, opts]

enter image description here

share|improve this answer
1  
+1 Neat trick ;) For good graphics quality keep PlotPoints option high in this case for original surface - like around 50 or more. –  Vitaliy Kaurov Nov 19 '12 at 6:21
    
@VitaliyKaurov True, I have corrected that now. Looks nicer. –  Matariki Nov 19 '12 at 6:55
    
+1 I used that trick in this question about drop shadows, too. If you want to project along a direction that's not parallel to the axes, there's just the additional complication that the scales along different axes may be different in the output of Plot3D - that's certainly the case in this potential plot. Anyway, it doesn't make a difference for a vertical projection as you did here. –  Jens Nov 19 '12 at 7:31
2  
@Jens Didn't know about your answer. Thanks for the link. In Mathematica V2 (if memory serves right) I used a function called ShadowPlot3D that did this type of pseudo projection. –  Matariki Nov 19 '12 at 8:01
1  
Sometimes there's more than one correct answer... –  QuantumDot Nov 20 '12 at 2:29

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.