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

Re: Mesh

• To: mathgroup at smc.vnet.net
• Subject: [mg23067] Re: Mesh
• From: "Allan Hayes" <hay at haystack.demon.co.uk>
• Date: Sat, 15 Apr 2000 03:00:25 -0400 (EDT)
• References: <8d0qte$4v8@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

Adam,

Below the line *********** I copy a package that Hartmut Wolf and I have
been working on for some time that you may find useful. This is still work
in progress and not tested as thoroughly as we would like - also we have
some further developments in mind.

A selection of examples is given at the end.
--
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

"Adam Halverson" <ahalvers at reed.edu> wrote in message
news:8d0qte$4v8 at smc.vnet.net...
> Is there a way to change mesh density so that it isn't 1:1 with
> PlotPoints?  When plotting some rapidly varying functions, I need to up
> the PlotPoints, but the Mesh gets so dense that the entire plot is
> black.  I don't want to plot without the mesh because it's tough to see
> how some of the smaller parts of the functions are changing without
> it...
>
> thanks

****************************************************************************
*********

(* :Name: Smooth3D` *)

(* :Title: Smooth3D *)

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

(* :Package Version: 1.0 *)

(* :Mathematica Version: 4.0 *)

(*:Summary:
 This package supports the functions Plot3D, ParametricPlot3D and its
 derivatives CylindricalPlot3D and SphericalPlot3D.
 This allows to draw the 3D plots at higher resolution and keep the
 size of the mesh.
*)

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


*)

BeginPackage[ "Smooth3D`", "Graphics`ParametricPlot3D`",
"Utilities`FilterOptions`"]

Smooth3D::usage = "Smooth3D allows to increase the resolution of the plots
 with Plot3D, ParametricPlot3D, CylindricalPlot3D,
 or SphericalPlot3D, without increasing the size of the mesh.
 \nSmooth3D[<plotfunction>[<parms>, (plot options..)], (mesh options..)]
 where <plotfunction> is the plotting procedure and parameters <parms> are
 supplied as to plot
 a function (or a list of functions for ParametricPlot3D) at \"normal\"
 resolution (as determined by PlotPoints)\nOption MeshScale -> n
 increases the linear resolution by a factor of n.";

MeshScale::usage = "MeshScale -> n or MeshScale -> {n, m},  n,m Integers
 increases the linear resolution of the plot by effectively multiplying
 with PlotPoints but does not increase the mesh size.
 \nDefault is three";

MeshLines::usage = "With MeshLines -> Automatic mesh size is according
 to the setting of option PlotPoints,
 MeshLines -> n or MeshLines -> {n, m} may override that.
 If specified differently for the plot variables, n corresponds
 to the first, m to the second one, i.e. defines the number of
 mesh lines with variable == const.\nDefault is Automatic";

MeshStyle::usage = MeshStyle::usage <> "\n\nWith Smooth3D MeshStyle can also
be
 applied to ParametricPlot3D and related functions";

Begin[ "`Private`"]

Attributes[Smooth3D] = HoldFirst;
Options[Smooth3D] = {MeshStyle -> {}, MeshLines -> Automatic, MeshScale ->
3};

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


Smooth3D[(plotfn_)[fun_, xrng_, yrng_, opts___], lineopts___?OptionQ] :=
  Module[ {stl, scl, lns, offset, pp, topp, ppfn, ppEnlarged, g, gNoMesh,
      gpoints, pointarray, xLines, yLines, plotopts},

 (*get option values*)
    {stl, scl,
        lns} = {MeshStyle, MeshScale, MeshLines} /. Flatten[{lineopts,
opts}] /.
        Options[Smooth3D];

    pp = PlotPoints /. Flatten[{opts, lineopts}] /.
          Options[plotfn] /. {Automatic -> If[plotfn === Plot3D, 15, 20]};
    pp = {1, 1} pp;

 (* deal with Automatic in MeshLines*)

    lns = Replace[lns, {Automatic -> pp, {Automatic, Automatic} -> pp,
          {Automatic, yp_} -> {pp[[1]], yp}, {xp_, Automatic} -> {xp,
              pp[[2]]},
          n_Integer :> {n, n}}];

 (*PlotPoints for smoother plot*)
    offset = Ceiling[(pp - 1)/(lns - 1)  scl];
    ppEnlarged = (lns - 1) offset + 1;

    g = With[{plotopts = FilterOptions[plotfn, {opts, lineopts}]},
        plotfn[fun, xrng, yrng,
           DisplayFunction -> Identity,
           PlotPoints -> ppEnlarged,
           plotopts
            ]];
    If[plotfn === Plot3D, g = Graphics3D[g]];

 (*make the edgeless polygons for smoothed graphics*)

    gNoMesh =
      g /. {{st__?(Head[#] =!= Polygon &), p_Polygon} -> {st, EdgeForm[],
p},
          p_Polygon -> {EdgeForm[], p}};

 (** make the styled grid lines **)

 (* list of quadruples of points used in polygons*)
    gpoints = Cases[g, Polygon[pts_] -> pts, Infinity];
    If[plotfn === Plot3D, gpoints = RotateLeft[gpoints, {0, 1}]];


 (*make the points used in gpoints into an array*)
    pointarray = MapAt[RotateRight[#, 2] &,
          Transpose[
            Append[#, RotateRight[Last[#], {0, -1}]] &[
              Transpose[
                Append[
                      #,
                      RotateRight[Last[#], {0, 1}]] &[
                   Partition[gpoints, ppEnlarged[[1]] - 1]]
                ]]],
          {{-1, -1}}][[All, All, 1]];


 (* the styled lines *)
    stl = Replace[stl, {stl__} :> stl];
    xLines =
      {stl,
        Line /@ (Flatten[#, 1] & /@ Partition[pointarray, 1, offset[[2]]])};
    yLines = {stl,
        Line /@ (Flatten[#, 1] & /@
              Partition[Transpose[pointarray], 1, offset[[1]]])};

 (*combine and show*)
    Show[gNoMesh, Graphics3D[{xLines, yLines}],
      DisplayFunction -> $DisplayFunction]
    ]

End[]

EndPackage[]


(*:Examples:

Smooth3D[CylindricalPlot3D[
      {Sin[5f], Hue[f/6Pi, .4, 1]}, {r, 2, 4}, {f, 0, 2 Pi},
      PlotPoints -> {2, 30},
      Lighting -> False
      ],
    MeshScale -> {1, 3}, MeshLines -> {2, 50},
    MeshStyle -> {Thickness[.001], Hue[.6]}
    ];

Smooth3D[ParametricPlot3D[{x, y, Sin[x + Cos[y]], {Hue[(x + y)/12, .5, 1]}}
      , {x, 1, 4}, {y, 1, 5},
      Lighting -> False], MeshStyle -> Hue[.7]
    , MeshLines -> 4
    ];

Smooth3D(*2*)[
    ParametricPlot3D[{x, y, Sin[x + Cos[y]], {Hue[(x + y)/12, .5, 1]}}
      , {x, 1, 4}, {y, 1, 5},
      Lighting -> False], MeshStyle -> {Thickness[.015], Hue[0]},
    MeshScale -> 1/7, MeshLines -> 4
    ];

Smooth3D[ParametricPlot3D[{x, y, Sin[x + Cos[y]], {Hue[(x + y)/12, .5, 1]}}
      , {x, 1, 4}, {y, 1, 5}, PlotPoints -> {3, 4},
      Lighting -> False, AxesLabel -> {"x", "y", "z"}],
    MeshStyle -> {Thickness[.015], Hue[0.45, 0.6, 1]},
    MeshScale -> {7, 5}, MeshLines -> {4, 5}
    ];

Smooth3D[ParametricPlot3D[{
        {x, y, Sin[x + Cos[y]], {Hue[(x + y)/12, .5, 1]}},
        {x, y, Cos[x + Sin[y]], GrayLevel[.5]}},
      {x, 1, 4}, {y, 1, 5},
      Lighting -> False], MeshStyle -> Hue[.7, 0.3, 1]
    , MeshLines -> 4
    ];

Smooth3D[Plot3D[{Sin[x + Cos[y]], Hue[x, .4, 1]}, {x, 1, 4}, {y, 1, 5},
      PlotPoints -> {5, 5}, MeshStyle -> {Thickness[0.01], GrayLevel[0.8]}],
    MeshScale -> {3, 3}
    ];

Smooth3D[Plot3D[Sin[x + Cos[y]], {x, 1, 4}, {y, 1, 5},
      ColorFunction -> (Hue[.85 #, .6, 1] &),
      PlotPoints -> 5], MeshScale -> 10];

Plot3D[Sin[x y], {x, 0, \[Pi]}, {y, 0, \[Pi]}] // Smooth3D;

Smooth3D[Plot3D[Sin[x y], {x, 0, -3\[Pi]/2}, {y, 0, -3\[Pi]/2},
      BoxRatios -> {1, 1, 0.2}], MeshScale -> 7];

Smooth3D[Plot3D[Cos[x y]Sin[x], {x, 0, 3\[Pi]/2}, {y, 0, 2\[Pi]},
    BoxRatios -> {1, 1.5, 0.3}], PlotPoints -> {15, 20}, MeshScale -> 7];

Smooth3D[SphericalPlot3D[{2,Hue[(theta+phi)/6]},
 {theta,0,Pi},{phi, 0,2Pi},PlotPoints ->5,
 Lighting ->False],MeshLines -> 5]

*)