10
$\begingroup$

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}]

left: Plot3D[Wig] right: Plot[mx]

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!

$\endgroup$
  • 2
    $\begingroup$ You can use ParametricPlot3D[] to plot your curves, and them combine them with the surface using Show[]. $\endgroup$ – J. M. is away May 24 '16 at 12:40
8
$\begingroup$

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]

enter image description here enter image description here

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

$\endgroup$
6
$\begingroup$

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]

enter image description here

$\endgroup$
  • $\begingroup$ ...with the caveat that FullGraphics[] may not always behave as desired (a deficiency that unfortunately remains unfixed). $\endgroup$ – J. M. is away May 24 '16 at 14:56
  • $\begingroup$ @J.M. Yes, I hope they fix will fit it someday, it seems to be a very useful function. $\endgroup$ – xslittlegrass May 24 '16 at 15:07
5
$\begingroup$
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]}] 

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.