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
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...
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
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
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.
-------------------------------------------------------------