Re: Question about a CountorPlot3D
- To: mathgroup at smc.vnet.net
- Subject: [mg117546] Re: Question about a CountorPlot3D
- From: Fred Klingener <gigabitbucket at BrockEng.com>
- Date: Tue, 22 Mar 2011 05:08:20 -0500 (EST)
- References: <im4iuk$d49$1@smc.vnet.net> <im7c61$6o$1@smc.vnet.net>
Here's a remix of a stab at the OP's spec, Samira Bahrami's "Wigner
Function of Harmonic Oscillator" Demonstration with Jens' construction
of the "floor" pattern. It runs fine in my 7.0.1, too.
As nifty as Texture is in its place, I have a hard time getting it to
work well in places like this. AFAIK, the scaling and positioning of
the texture image of the floor wrt its host Polygon is a fussy and
fragile thing, but with Jens' method, we get all that directly and
robustly. Very slick.
Here, the Manipulate variable steps through the odd values of n from 1
to 19, where the Wigner function is given as (-1)^n (1/\[Pi])E^-
(p^2+q^2) LaguerreL[n,2(p^2+q^2)].
Module[{blueWhite, wigner}
, Manipulate[
Show[
Graphics3D[
First@
ContourPlot[
wigner[p, q, n]
, {p, -1, 1}
, {q, -1, 1}
, ContourStyle -> None
, ColorFunction -> blueWhite
] /.
GraphicsComplex[pnts_, data__] :>
GraphicsComplex[(Append[#1, -1] &) /@ pnts, data]
]
, Graphics3D[{
Blue
, Point /@ (Plot3D[
wigner[p, q, n]
, {p, -1, 1}
, {q, -1, 1}
, Mesh -> None
, MaxRecursion -> 0
, PlotPoints -> 50
])[[1]] /. GraphicsComplex[pt_, ___] :> pt
}]
]
, {n, 1, 20, 2}
, Initialization :> (
blueWhite[x_] := RGBColor[x, x, 1];
wigner[p_, q_, n_] := (-1)^
n (1/\[Pi]) E^-(p^2 + q^2) LaguerreL[n, 2 (p^2 + q^2)];
)]
]
Hth,
Fred Klingener
On Mar 21, 7:18 am, Peter Breitfeld <ph... at t-online.de> wrote:
> Iv=E1n Lazaro wrote:
> > Hi all!
>
> > This may be silly, but I want to know if is posible to make a CountorPl=
ot3D
> > like the one is shown in the link.
>
> > I'm specially interested in the "projection". Is it possible?
>
> > Thanks a lot!
>
> > Image:
> >http://209.85.62.24/28123/36/0/p397406/Wigner.jpg
>
> Some years ago Jens-Peer Kuska posted a solution:
>
> fun = Sin[x*y];
> dpl = DensityPlot[fun, {x, -Pi, Pi}, {y, -Pi, Pi}];
> plt3d = Plot3D[fun, {x, -Pi, Pi}, {y, -Pi, Pi}];
>
> Head /@ {dpl, dpl[[1]], plt3d,plt3d[[1]]}
>
> Show[
> Graphics3D[{
> plt3d[[1]],
> dpl[[1]] /.
> GraphicsComplex[pnts_, data__] :>
> GraphicsComplex[(Append[#1, -2] &) /@ pnts, data]}],
> Axes -> True]
>
> As you can see, dpl is a 2D Graphics object, realised by
> GraphicsComplex. The replacement rule makes all points {x,y} to
> {x,y,-2}, so creating a 3D GraphicsComplex, wich can be rendered by
> Graphics3D.
>
> //Peter
> --
> _________________________________________________________________
> Peter Breitfeld, Bad Saulgau, Germany --http://www.pBreitfeld.de
