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] *)