# Plot independent 2D graphs on walls of 3D Plot

Sorry, I know a lot of similar questions have been asked before, but I just can't find one that exactly describes my problem.

How can I make the according 2D (marginal distribution) graphs appear on both sidewalls of a 3D Plot (of a Wigner function)?

The thing is the 2D graphs are not direct projections of the 3-dimensional object!

I have my Wigner function 3d-Plot:

Wig[n_, x_, y_] := (1/Pi) Exp[-(x^2 + y^2)] (-1)^n  LaguerreL[n, 2(x^2 + y^2)];


and the corresponding marginal distributions defined by choice of same n value:

mx [n_, x_] := Sqrt[2/Pi] (1/(n! 2^n))*Exp[-2 x^2] HermiteH[n, Sqrt[2] x]^2;
my [n_, y_] := Sqrt[2/Pi] (1/(n! 2^n))*Exp[-2 y^2] HermiteH[n, Sqrt[2] y]^2;


I can plot these separately:

Plot3D[Wig[3, x, y] , {x , -3.5 , 3.5 }, {y, -3.5, 3.5 }, PlotRange -> All]
Plot[mx[3, x], {x , -3.5 , 3.5}]


But instead I'd like to have the 2D graph mx to be plotted on the back wall of the box and my on the side wall together with Wig inside the box...

Is there an easy way to do so? Thanks for your help!

• You can use ParametricPlot3D[] to plot your curves, and them combine them with the surface using Show[]. May 24, 2016 at 12:40

working with Texture:

Wig[n_, x_,
y_] := (1/Pi) Exp[-(x^2 + y^2)] (-1)^n LaguerreL[n, 2 (x^2 + y^2)];
mx[n_, x_] :=
Sqrt[2/Pi] (1/(n! 2^n))*Exp[-2 x^2] HermiteH[n, Sqrt[2] x]^2;
my[n_, y_] :=
Sqrt[2/Pi] (1/(n! 2^n))*Exp[-2 y^2] HermiteH[n, Sqrt[2] y]^2;
p2d = Plot[mx[3, x], {x, -3.5, 3.5}];
range = {{-3.5, 3.5}, {-3.5, 3.5}, {-1/2, 1/2}};
poly = {
{range[[1, 1]], range[[2, 1]], 0},
{range[[1, 2]], range[[2, 1]], 0},
{range[[1, 2]], range[[2, 1]], range[[3, 2]]},
{range[[1, 1]], range[[2, 1]], range[[3, 2]]}};
Show[ {
Plot3D[Wig[3, x, y], {x, -3.5, 3.5}, {y, -3.5, 3.5},
PlotRange -> range],
Graphics3D[{Texture[Rasterize[p2d, Background -> None,
ImageResolution->300]],
EdgeForm[None],
Polygon[poly,
VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}]
}, PlotRange -> All]


I'm sure you could make that look a lot better if you work the styles on the 2d plot.

Apart from using texture, you can also convert the 2D plot to 3D plot directly. For example,

p1 = Plot3D[Wig[3, x, y], {x, -3.5, 3.5}, {y, -3.5, 3.5}, PlotRange -> All];
p2 = Plot[mx[3, x], {x, -3.5, 3.5}];
p3 = Graphics3D @@
(FullGraphics[p2] /. Line[pts__] :> Line[pts /. {x_, y_} :> {x, -3.5, y}]);

Show[p1,p3]


• ...with the caveat that FullGraphics[] may not always behave as desired (a deficiency that unfortunately remains unfixed). May 24, 2016 at 14:56
• @J.M. Yes, I hope they fix will fit it someday, it seems to be a very useful function. May 24, 2016 at 15:07
ParametricPlot3D[{{x, y, Wig[3, x, y]},
{x, Pi, Rescale[y, {-Pi, Pi}, {0, 1}] mx[3, x]},
{-Pi, y, Rescale[x, {-Pi, Pi}, {0, 1}] mx[3, y]}},
{x, -Pi, Pi}, {y, -Pi, Pi},
Mesh -> None,   PlotRange -> All, BoxRatios -> 1,
PlotStyle -> {LightBlue, Directive[EdgeForm[], Red], Directive[EdgeForm[], Green]}]