Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Fancy 3d plotting in Mathematica

28 views
Skip to first unread message

mike_in_e...@yahoo.co.uk

unread,
Aug 24, 2005, 6:33:59 AM8/24/05
to
Hi

Using 3D plot I can make a very nice surface plot of the sinc function:

Plot3D[Sin[Sqrt[x*x +
y*y]]/Sqrt[x*x + y*y], {x, -10, 10}, {y, -10, 10}, PlotRange ->
All]

and I can do Contour plots:

ContourPlot[Sin[Sqrt[x*x + y*y]]/Sqrt[x*x + y*y], {x, -10, 10}, {
y, -10, 10}, PlotRange -> All]

And all this is very nice. However is it straightforward to combine
these plots a la Gnuplot:

http://chem.skku.ac.kr/~wkpark/tutor/gnuplot/gpdocs/imgs/contours17.png

Thanks for your time

Mike

Jens-Peer Kuska

unread,
Aug 25, 2005, 6:37:11 AM8/25/05
to
Hi,

not exactly but Graphics`Graphics3D`ShadowPlot3D[]
will
do something similar. Or
Block[{$DisplayFunction=Identity},

surf = Plot3D[Sin[Sqrt[x*x +


y*y]]/Sqrt[x*x + y*y], {x, -10, 10}, {y, -10, 10},
PlotRange ->

All];

cntr = ContourPlot[Sin[Sqrt[x*x + y*y]]/Sqrt[x*x +

y*y], {x, -10, 10}, {

y, -10, 10}, PlotRange -> All];

]

Show[surf,
Graphics3D[
Cases[Graphics[cntr], _Line, Infinity] /.
Line[pnts_] :> Line[Append[#, -1] & /@ pnts]],
BoxRatios -> {1, 1, 1}]


Regards
Jens
<mike_in_e...@yahoo.co.uk> schrieb im
Newsbeitrag news:dehien$bsg$1...@smc.vnet.net...

Jose Luis Gomez

unread,
Aug 25, 2005, 6:55:25 AM8/25/05
to

Mike, the standard Add-On library Graphics`Graphics3D has a command
ShadowPlot3D that can be used to produce graphs similar to the one you want.
Look at the example in the following link:

http://homepage.cem.itesm.mx/jose.luis.gomez/shadowplot3d/

Regards!
José Luis

-----Mensaje original-----
De: mike_in_e...@yahoo.co.uk [mailto:mike_in_e...@yahoo.co.uk]

Enviado el: Miércoles, 24 de Agosto de 2005 05:30 a.m.
Para: math...@smc.vnet.net
Asunto: Fancy 3d plotting in Mathematica

Jeff Bryant

unread,
Aug 26, 2005, 5:04:04 AM8/26/05
to
This should get you pretty close to what you want:

In[1]:= <<Graphics`

In[2]:=
surf = Plot3D[Sin[Sqrt[x*x + y*y]]/Sqrt[x*x + y*y],
{x, -10, 10}, {y, -10, 10}, PlotRange -> All,
DisplayFunction -> Identity];

In[3]:=
cntrs = ContourPlot[Sin[Sqrt[x*x + y*y]]/


Sqrt[x*x + y*y], {x, -10, 10}, {y, -10, 10},

PlotRange -> All, ContourShading -> False,
ContourStyle -> Table[{Hue[0.8*x]},
{x, 0, 1, 0.1}], Contours -> 10,
PlotPoints -> 30, DisplayFunction -> Identity];

In[4]:=
Show[Graphics3D[{Red, WireFrame[surf][[1]],
Graphics[cntrs][[1]] /. {x_, y_} -> {x, y, -1}}],
BoxRatios -> {1, 1, 1/GoldenRatio}, Axes -> True,
ViewPoint -> {-1, 2, 1}, AxesLabel ->
{"X axis", "Y axis", "Z axis"}]

-Jeff

Zhengji Li

unread,
Aug 26, 2005, 5:23:11 AM8/26/05
to
Here is my code showing how to combine a 2D graphic with a 3D graphic.

This gives what you need ?
Plot3DPlus[5Sin[Sqrt[


x*x + y*y]]/Sqrt[x*x + y*y], {x, -10, 10}, {

y, -10, 10}, Lighting -> False,
ColorFunction -> Hue, PlotPoints -> 30, Post2DFunction ->
ContourGraphics, Post2DPosition -> Below, AspectRatio -> 1];

To get exactly what you need, please see FullGraphics.

Post2DFunction::usage = "";
Post2DPosition::usage = "";
Above::usage = "";
Below::usage = "";
SubPlotOffset = 2;
Options[Plot3DPlus] = {
Post2DFunction -> ContourGraphics, Post2DPosition -> Below};
Plot3DPlus[f_, xvar_, yvar_, opts___] := Module[
{g, pr, data, fun, pos, res, zmin, zmax, z, scalez},
Point2Dto3D[pt : {x_, y_, ___}] := {x, y, z};
Point2Dto3D[Scaled[x_, y_, ___]] := Scaled[x, y, scalez];

fun = Post2DFunction /. Flatten[{opts}~Join~Options[Plot3DPlus]];
pos = Post2DPosition /. Flatten[{opts}~Join~Options[Plot3DPlus]];

g = Plot3D[f, xvar, yvar,
DisplayFunction -> Identity, Evaluate@DeleteCases[Flatten@{opts},
Rule[Post2DFunction, _] | Rule[Post2DPosition, _]]];
pr = PlotRange /. AbsoluteOptions[g, PlotRange];
{zmin, zmax} = pr[[3]];
If[pos === Below,
z = zmin - SubPlotOffset(zmax - zmin); zscale = 0,
z = zmax + SubPlotOffset(zmax - zmin); zscale = 1
];

data = Flatten[Graphics[fun[g]][[1]]];
data = DeleteCases[
data, _Rectangle | _Circle | _Disk | _Raster | _RasterArray];
data = (If[MemberQ[{Line, Polygon, Point},
Head@#], (Head@#)[Function[pt, Point2Dto3D[pt]] /@ #[[
1]]], #]) & /@ data;
res = {g, Graphics3D[data, Lighting -> False]};
Show[res, DisplayFunction -> $DisplayFunction];
res
];

--
Li Zhengji
-------------------------------------------------------------
If all you have is a hammer, everything is a nail.
-------------------------------------------------------------

0 new messages