MathGroup Archive 2005

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Plot3D gives serrated ridge

  • To: mathgroup at smc.vnet.net
  • Subject: [mg54862] Re: Plot3D gives serrated ridge
  • From: "Peltio" <peltio at trilight.zone>
  • Date: Fri, 4 Mar 2005 05:07:57 -0500 (EST)
  • References: <d01538$ov0$1@smc.vnet.net> <d03ng6$858$1@smc.vnet.net>
  • Reply-to: "Peltio" <peltioNOSPAM at despammed.com.invalid>
  • Sender: owner-wri-mathgroup at wolfram.com

"Jon Harrop" wrote:

>Hugh Goyder wrote:
>> Any suggestions for improving the plot?
>
>Use Plot3D to do the shaded surface (with a single white light) and then
add
>your own code to plot the grid at a lower sampling but the same resolution:
>
>\!\(\(With[{n = 128, m = 32, xmin = 4, xmax = 5.5, zmin = 4.5, zmax = 5},
>      Show[{Graphics3D[
>            Plot3D[Evaluate[Abs[f]], {k1, xmin, xmax}, {k, zmin, zmax},
snip-

That's nice.
Here's a procedure that implements your suggestions with a few options: the
number of intervals of the plot in the x and y directions, the number of
intervals between lines crossing the x and y axis, plus their style (only a
a list of two lists).
Oh, yes, there is also a GridOffset value that can be useful to lift the
grid and avoiding its being hidden by the surface. Adding 1% to 3-5% of
the plotrange should work in most cases.

(*======================================================*)
(*WirePlot3D*)
(*======================================================*)

Needs["Utilities`FilterOptions`"]

Options[WirePlot3D] = {PlotLines -> 15, PlotPoints -> 100,
    GridOffset -> 0, LightSources -> {{{0, 1, 0.65}, RGBColor[1, 1, 1]}},
    Mesh -> False, WireStyle -> {{GrayLevel[0]}, {GrayLevel[0]}}};

WirePlot3D[g_, {x1_Symbol, xmin_, xmax_}, {x2_Symbol, ymin_, ymax_},
   opts___Rule] :=
    Module[
    {n, m, x, y, f, fr, p3opts, shopts, funplot,
    linplot, i, j, px, py, lx, ly, eps, xlinsty, ylinsty},

    p3opts = FilterOptions[Plot3D, Join[{opts}, Options[WirePlot3D]]];
    shopts = FilterOptions[Show, Join[{opts}, Options[WirePlot3D]]];
    n = Flatten[{PlotPoints /. {opts} /. Options[WirePlot3D]}];
    {px, py} = {First[n], Last[n]};
    m = Flatten[{PlotLines /. {opts} /. Options[WirePlot3D]}];
    {lx, ly} = {First[m], Last[m]};
    eps = GridOffset /. {opts} /. Options[WirePlot3D];
    xlinsty = First[WireStyle /. {opts} /.  Options[WirePlot3D]];
    ylinsty = Last[WireStyle /. {opts} /. Options[WirePlot3D]];

    f[x_, y_] = g /. {x1 -> x, x2 -> y};
    funplot = Plot3D[Evaluate[f[x, y]], {x, xmin, xmax}, {y, ymin, ymax},
      PlotPoints -> Evaluate[{px + 1, py + 1}], Evaluate[p3opts],
      DisplayFunction -> Identity
    ];
    fr[i_, j_] := Block[
        {x = ((px - i)*xmin + i*xmax)/px, y = ((py - j)*ymin + j*ymax)/py},
        {x, y, f[x, y] + eps}];
    linplot = Graphics3D[{
        {Sequence @@ xlinsty,
        Table[Line[Table[fr[i, j], {i, 0, px}]], {j, 0, py, py/ly}]},
        {Sequence @@ ylinsty,
        Table[Line[Table[fr[i, j], {j, 0, py}]], {i, 0, px, px/lx}]}}
    ];
    Show[{Graphics3D[funplot], linplot},
     shopts, DisplayFunction -> $DisplayFunction]
]

(*======================================================*)


A few examples:

WirePlot3D[Exp[-0.1 x y^2] Sin[x] Cos[y], {x, -2, 3}, {y, -3, 5},
  PlotPoints -> {100, 50}, PlotLines -> 10, GridOffset -> 0.05]

Clear[f]
f[x_, y_] := Exp[-0.1 x y - y^2 x] Sin[x] Cos[y]
WirePlot3D[f[x, y], {x, 0.2, 4}, {y, -3, 3}, PlotLines -> {20, 40},
  WireStyle -> {{GrayLevel[0.84]}, {GrayLevel[0.15]}},
  GridOffset -> 0.002, PlotRange -> {-0.5, 0.5}]

Clear[f];
f = -((2 I)/(4 - 100 (9.42477796076938 + 0.01 I - 2 k)*
        (0.047123889803846894 I - k + k1)));
WirePlot3D[Abs[f], {k1, 4, 5.5}, {k, 4.5, 5}, PlotPoints -> 128,
PlotLines -> 32]

cheers,
Peltio



  • Prev by Date: Re: Rearranging a data array containing calendrical as well as data entries.
  • Next by Date: Re: Rearranging a data array containing calendrical as well as data entries.
  • Previous by thread: Re: Plot3D gives serrated ridge
  • Next by thread: Re: Simplify and Abs