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