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

Re: Plot3D

• To: mathgroup at smc.vnet.net
• Subject: [mg28877] Re: Plot3D
• From: "Allan Hayes" <hay at haystack.demon.co.uk>
• Date: Thu, 17 May 2001 04:22:48 -0400 (EDT)
• References: <9dtb7a$f9m@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

Markus Riedle" <riedle at math.tu-berlin.de> wrote in message
news:9dtb7a$f9m at smc.vnet.net...
>
> I want to plot a function with "Plot3d" and with face grids.
> But if the function is evaluated in many sample points there is nothing
> than the face grids. How can I plot a face grids only in few points and
> not in all sample points?

Markus, it may be that you area referring to the mesh on the surface rather
than the face grids on the bounding box faces - which do not depend on the
number of sample points.

Here is a package that Hartmut Wolf and I developed to deal with this kind
of problem.
It is discussed in the current issue of Mathematica in Education and
Research (Volume 9 No.2)

Allan
---------------------
Allan Hayes
Mathematica Training and Consulting
Leicester UK
www.haystack.demon.co.uk
hay at haystack.demon.co.uk
Voice: +44 (0)116 271 4198
Fax: +44 (0)870 164 0565




(* : Title : Smooth3D *)

(* : Context : Smooth3D` *)

(* : Author : Allan Hayes, Hartmut Wolf*)

(* : Package Version : 1.0 *)

(* : Mathematica Version : 3.0 and later *)

(*: Summary :
 This package supplements the functions Plot3D, ParametricPlot3D,
 CylindricalPlot3D and SphericalPlot3D.
 It lets us specify more plot points and the number and style
 of the mesh lines.
*)

(* : History :
 Created November 1999 / April 2000 by Allan Hayes and Hartmut Wolf.
*)

(*BEGIN PACKAGE CONTEXT*)
BeginPackage["haypacks`Graphics`Smooth3D`", "Graphics`ParametricPlot3D`",
    "Utilities`FilterOptions`"];

Unprotect["`*"];
ClearAll["`*"];

(*USAGE MESSAGES*)

Smooth3D::usage = "Smooth3D[plotfn[.,{x..},{y..}], MeshLines -> {xln ,yln},
\
MeshStyle -> {xstl, ystl}, Smoothing -> {sx,sy}] gives xln mesh lines with \
style xstl at equally spaced x values, and with the x-spacing between the \
plot points not more than 1/sx times that for
plotfn[.,{x..},{y..}](similarly \
with x replaced by y). Where plotfn can be Plot3D, ParametricPlot3D, \
CylindricalPlot3D or SphericalPlot3D. The defaults for the options are
\n Smoothing -> 1 {equivalent to {1,1}}
\n MeshLines -> Automatic
\n \t(giving same numbers of mesh lines as the original)
\n MeshStyle -> Automatic
\n\n Examples: please enter Smooth3DExamples.
\n Input cells will be made below the entry cell.
";

Smooth3DExamples::usage = "Smooth3DExamples generates a sequence of Smooth3D
\
examples in separate input cells immediately after the entry cell";

Smoothing::usage = "Smoothing -> {sx, sy}, sx, sy positive Integers,
gives an x-spacing between the plot points not more than 1/sx times that in
\
the original plot(similarly with x replaced by y).
\n Smoothing -> n is equivalent to Smoothing -> {n,n}
\n Default is Smoothing -> 1";

MeshLines::usage = "MeshLines -> {xln ,yln}, where xln, yln are integers >
1, \
gives xln mesh lines at equally spaced x values, similarly for yln.
\n MeshLines -> {0 ,yln} gives no mesh lines at x values.
\n MeshLines -> {Automatic,yln} gives the same number of mesh lines at x \
values as in the original,
\n MeshLines-> mln (not a list) is equivalent to MeshLines -> {mln, mln}
\n Default is MeshLines -> Automatic, giving the same mesh lines as in the \
original.";


If[! StringMatchQ[#, "*Smooth3D*"],
      Smooth3D::usage =
        MeshStyle::usage = (# <>
 "\n\nWith Smooth3D, MeshStyle ->{xstl,ystl} gives the style \
 xstl to the meshlines at constant x values, and the style ystl to the mesh
\
 lines at constant y values;
 \n MeshStyle -> stl is equivalent to MeshStyle -> {stl, stl}.
 \n Default is MeshStyle -> Automatic, which gives MeshStyle -> {{},{}} "
 )] &[Cases[{MeshStyle::usage}, _String, 2][[1]]];



(*BEGIN PRIVATE CONTEXT*)
Begin["`Private`"];

SetAttributes[Smooth3D, HoldFirst];

(*specify default options*)
Options[Smooth3D] =
 {MeshStyle -> Automatic, MeshLines -> Automatic,
       Smoothing -> 1};

(*allow for a list of plotted functions*)
  Smooth3D[(plotfn_)[{f__List}, xrng_, yrng_, opts___], lineopts___?OptionQ]
:=
   Show[Block[{$DisplayFunction = Identity},
      Smooth3D[plotfn[#, xrng, yrng, opts], lineopts] & /@ {f}],
    DisplayFunction -> $DisplayFunction];

(*main code - for plotting a single function*)
  Smooth3D[(plotfn_)[fun_, xrng_, yrng_, opts___], lineopts___?OptionQ] :=
  Module[{stl, smth, lns, pp, lns2, mult, ppEnlarged, g, gNoMesh, gpoints,
      pointarray, xstl, ystl, xLines, yLines},

    (*get option values*)
    {stl, smth,  lns} =
    {MeshStyle, Smoothing, MeshLines} /.
  Flatten[{lineopts}] /. Options[Smooth3D];
    pp =
      PlotPoints /. Flatten[{opts, lineopts}] /.
          Options[plotfn] /. {Automatic -> If[plotfn === Plot3D, 15, 20]};

    (*standardize pp and lns to two numerical entry form*)
    pp = {1, 1}pp;
    lns =
      Replace[lns, {Automatic -> pp, {Automatic, Automatic} ->
            pp, {Automatic, yp_} -> {pp[[1]], yp}, {xp_, Automatic} -> {xp,
              pp[[2]]}, n_Integer -> {n, n}}];

     (*allow for no lines*)
    lns2 = lns /. {i_Integer /; i < 2 -> 2};

    (* get minimum plotpoints, ppEnlarged, needed for the smoothing, smth*)
    mult = Ceiling[(pp - 1)/(lns2 - 1) smth];
    ppEnlarged = (lns2 - 1) mult + 1;

    (*make smooth graphics g : filtering options to those accepted by
plotfn;
      suppress display with DisplayFunction -> Identity *)
    g = With[{plotopts = FilterOptions[plotfn, {opts, lineopts}]},
        plotfn[fun, xrng, yrng, DisplayFunction -> Identity,
          PlotPoints -> ppEnlarged, plotopts]];

    (*if plotfn is Plot3D then g is a SurfaceGraphics object : transform it
to
     a Graphics3D object so that the surface polygons are explicit*)
    If[plotfn == Plot3D, g = Graphics3D[g]];

   (*make the polygons in g edgeless - the required mesh will be added
later*)    gNoMesh =
      g /. {{st___?(Head[#] =!= Polygon &), p_Polygon} ->
           {st, EdgeForm[], p}, p_Polygon -> {EdgeForm[], p}};

   (*make the styled mesh lines*)(*list of quadruples of points used in
polygons*)
   gpoints = Cases[g, Polygon[pts_] -> pts, Infinity];

   (*if plotfn is Plot3D adjust gpoints*)
    If[plotfn == Plot3D, gpoints = RotateLeft[gpoints, {0, 1}]];

   (*make gpoints into an array of dimensions ppEnlarged - 1*)
    pointarray =
      Map[First,
        MapAt[RotateRight[#, 2] &,
          Transpose[
            Append[#, RotateRight[Last[#], {0, -1}]] &[
              Transpose[
                Append[#, RotateRight[Last[#], {0, 1}]] &[
                  Partition[gpoints,
                    ppEnlarged[[1]] - 1]]]]], {{-1, -1}}], {2}];

    (*set the styles for the mesh lines*)
    {xstl, ystl} =
      Replace[stl, {Automatic -> {{}, {}}, {a_List, b_List} -> {a,
              b}, {a_List, b_} -> {a, {b}}, {a_, b_List} -> {{a},
              b}, {a___} -> {{a}, {a}}, a_ -> {{a}, {a}}}];

   (*make the styled lines*)
    xLines =
      Append[xstl,
        If[lns[[1]] == 0, {},
          Line /@ (Flatten[#, 1] & /@
                Partition[Transpose[pointarray], 1, mult[[1]]])]];
    yLines =
      Append[ystl,
        If[lns[[2]] == 0, {},
          Line /@ (Flatten[#, 1] & /@ Partition[pointarray, 1,
mult[[2]]])]];

   (*show combined lines and surface*)
    Show[gNoMesh, Graphics3D[{xLines, yLines}],
      DisplayFunction -> $DisplayFunction]];

(*EXAMPLES*)

Smooth3DExamples :=
  CellPrint[
    Cell[#, "Input", GeneratedCell -> False] & /@
      Reverse[{
 "Smooth3D[CylindricalPlot3D[\n{Sin[5f], {Hue[f/(.4Pi), .4, 1]}},
 \n{r, 2, 4}, {f, 0, 2 Pi},
 \nLighting -> False
 \n],
 Smoothing -> {1, 5}, MeshLines -> {3, 0}, MeshStyle -> Hue[0]
 \n];",

  "Smooth3D[Plot3D[\n{Sin[x + Cos[y]], Hue[x, .4, 1]},
 \n{x, 1, 4}, {y, 1, 5}
 \n],
 MeshStyle -> {{Thickness[.015], Hue[0.9]}, {Thickness[.01], Hue[.7]}},
 MeshLines -> {3, 5}
 \n];",

 "Smooth3D[ParametricPlot3D[
 \n{{x, y, Sin[x + Cos[y]], {Hue[(x + y)/12, .5, 1]}},
    {x, y, Cos[x + Sin[y]], GrayLevel[.5]}},
 \n{x, 1, 4}, {y, 1, 5},
 \nLighting -> False, Background -> Hue[0.15, 0.15, 1]\n],
 MeshStyle -> {{Thickness[.015], Hue[0]}, {Hue[.7]}}, MeshLines -> 4
 \n]",

 "Smooth3D[SphericalPlot3D[
 \n2,
 \n{theta, 0, Pi}, {phi, 0, 2Pi}
 \n],
 MeshLines -> {5, 6}, LightSources -> {{{-2.7, 2., 2.5},GrayLevel[1]}},
 MeshStyle -> {{Thickness[.01], Hue[0]}, {Thickness[.01], Hue[.7]}}
 \n];",

           "Smooth3D[SphericalPlot3D[
 \n{1 - 0.3/(1 +(0.7 + Tan[theta - Pi/2])^2),
 \n{SurfaceColor[ Hue[1/6, .3, 1], Hue[1/6, 1, 1], 8]}},
 {theta, 0, Pi}, {phi, 0, 2Pi},
 \nBoxed -> False, Axes -> False, Compiled -> False,
 AmbientLight -> GrayLevel[.3], PlotPoints -> 15
 \n],
 MeshStyle -> Hue[0.25, 1, 0.7], Smoothing -> 6
 \n];"}
]];

(*END PRIVATE CONTEXT - revert to original*)
End[];

(*Protect all symbols in the package context*)

Protect["`*"];

(*END PACKAGE CONTEXT*)
EndPackage[];



"Markus Riedle" <riedle at math.tu-berlin.de> wrote in message
news:9dtb7a$f9m at smc.vnet.net...
>
> Hey, I have a question:
>
> I want to plot a function with "Plot3d" and with face grids.
> But if the function is evaluated in many sample points there is nothing
> than the face grids. How can I plot a face grids only in few points and
> not in all sample points?
>
> Thanks a lot,
> Markus
>
>
>
>