# How to combine a 3D plot and a 2D density plot? [duplicate]

I am new to mathematica and I know there are questions related to this topic but I could not find mine. My supervisor has asked me to shadowplot my Wigner functions which he showed me is like the following image: From what I see, this image is a combination of a 3D plot and a 2D density plot of the Wigner function. This is an image from MATLAB but I want to plot my function using Mathematica as I have never used MATLAB before. I have tried plotting it like this:

a = -(E^-Abs[(0. + 1.6487212707001282 I) p +
0.6065306597126334 q]^2/\[Pi]) +
0.6366197723675815 E^-Abs[(0. + 1.6487212707001282 I) p +
0.6065306597126334 q]^2 Abs[(0. + 1.6487212707001282 I) p +
0.6065306597126334 q]^2;

p1 = Plot3D[a, {q, -2, 2}, {p, -2, 2}, PlotRange -> All,
ImageSize -> Small, ColorFunction -> "Rainbow"];

p2 = DensityPlot[a, {q, -2, 2}, {p, -2, 2}, PlotRange -> All,
ColorFunction -> "Rainbow", ImageSize -> Small];

p3 = Plot3D[0, {q, -2, 2}, {p, -2, 2}, PlotStyle -> Texture[p2],
Mesh -> None]

Show[p1, p2, PlotRange -> {-2, 2}];


But it gives me the following image: How do I get my desired plot?

Moreover, how to do the same for the following complex expression because in this case using MinValue command doesn't work?

'''a1 = (2 E^(-2 Abs[-(1/Sqrt) + I p + q]^2) (7 - 20 I Sqrt p -
24 p^2 - 20 Sqrt q + 48 I p q + 24 q^2 +
8 (-3 + 8 p^2 + 8 I p (Sqrt - 2 q) + 8 Sqrt q -
8 q^2) Conjugate[p]^2 +
4 (-5 Sqrt + 16 Sqrt p^2 + 28 q - 16 Sqrt q^2 -
4 I p (-7 + 8 Sqrt q)) Conjugate[q] +
8 (3 - 8 p^2 - 8 I p (Sqrt - 2 q) - 8 Sqrt q +
8 q^2) Conjugate[q]^2 +
4 Conjugate[
p] (-16 I Sqrt p^2 - 4 p (-7 + 8 Sqrt q) +
I (5 Sqrt - 28 q + 16 Sqrt q^2) -
4 (-8 I p^2 + 8 p (Sqrt - 2 q) +
I (3 - 8 Sqrt q + 8 q^2)) Conjugate[
q])))/(3 \[Pi] (Sqrt - 4 I p - 4 q) (Sqrt +
4 I Conjugate[p] - 4 Conjugate[q]))'''


You can use SliceDensityPlot3D.

With a and p1 in OP then find minimum to position slice.

min = MinValue[a, {p, q}]

-0.31831

p3 = SliceDensityPlot3D[a, {"ZStackedPlanes", {min - .1}}
, {q, -2, 2}, {p, -2, 2}, {z, min - .1, min - .2}
, PlotRange -> All
, ColorFunction -> "Rainbow"];

Show[p1, p3] Hope this helps.

• Thank you. It gave me exactly what I wanted. Now I know its too dumb to ask but did you auto-rotate this using mathematica? Apr 24, 2022 at 15:55
• @Anaya You just click and drag the plot in Mathematica to rotate it. Apr 24, 2022 at 17:27
• No I meant how to make it rotate like an animation. I want to add my plots to my presentation and if they are auto-rotating like the one above, it would be more clear to my audience Apr 25, 2022 at 5:27
• @Anaya looks to me like he simply used some screen recorder. You can see the mouse cursor in the image. No idea which he used. but googling "screen recorder gif" gives several possibilities
– Ivo
Apr 25, 2022 at 10:13
• @Anaya I used ShareX. I think it's open-source. Apr 25, 2022 at 11:07
a = -(E^-Abs[(0. + 1.6487212707001282 I) p +
0.6065306597126334 q]^2/\[Pi]) +
0.6366197723675815 E^-Abs[(0. + 1.6487212707001282 I) p +
0.6065306597126334 q]^2 Abs[(0. + 1.6487212707001282 I) p +
0.6065306597126334 q]^2;

p1 = Plot3D[a, {q, -2, 2}, {p, -2, 2}, ColorFunction -> "Rainbow",
PlotRange -> All];
p2 = Plot3D[a, {q, -2, 2}, {p, -2, 2}, ColorFunction -> "Rainbow",
PlotRange -> All,
Lighting -> {DirectionalLight[White, {{1, 1, -5}, {1, 1, 0}}],
DirectionalLight[White, {{1, 1, 5}, {1, 1, 0}}]}];
Show[p2 /. {x_Real, y_Real, z_Real} :> {x, y, -.5}, p1] • SliceDensityPlot3D also work. Apr 24, 2022 at 13:16
• For some reason my laptop just freezed running this. Apr 25, 2022 at 1:45
a = -(E^-Abs[(0. + 1.6487212707001282 I) p +
0.6065306597126334 q]^2/\[Pi]) +
0.6366197723675815 E^-Abs[(0. + 1.6487212707001282 I) p +
0.6065306597126334 q]^2 Abs[(0. + 1.6487212707001282 I) p +
0.6065306597126334 q]^2;

p1 = Plot3D[a, {p, -2, 2}, {q, -2, 2}
, PlotRange -> All
, ColorFunction -> "Rainbow"
, AxesLabel -> Automatic
, BoxRatios -> {1, 1, 1}
, ImageSize -> Medium
, AxesLabel -> {"p", "q", "W"}
, AxesEdge -> {{-1, -1}, {1, -1}, Automatic}
]

p2 = SliceContourPlot3D[a
, {z == -2}
, {p, -2, 2}
, {q, -2, 2}
, {z, -4, 0}
, ColorFunction -> "Rainbow"
, ContourStyle -> None
, AxesLabel -> {"p", "q", "W"}
, AxesEdge -> {{-1, -1}, {1, -1}, Automatic}
]

Show[p1, p2] 