Re: Q: smooth 3Dplot with big mesh
- To: mathgroup at smc.vnet.net
- Subject: [mg20927] Re: [mg20861] Q: smooth 3Dplot with big mesh
- From: "Allan Hayes" <hay at haystack.demon.co.uk>
- Date: Wed, 1 Dec 1999 01:49:57 -0500 (EST)
- References: <199911170840.DAA02585@smc.vnet.net> <199911180609.BAA06201@smc.vnet.net> <812aov$1hj@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Hartmut, Nice function. Just one problem - with the mesh lines generated by bigMesh (see first example). I have dealt with this in code for the development Smooth3D below and added functionality: - deduces the plot points used when the value of PlotPoints involves Automatic; - accepts ParametricPlot3D and Plot3D as well as CylindricalPlot3D; - accepts styles for all of the inputs; - includes styling for the mesh lines. ----------------- bigMesh ----------------- Attributes[bigMesh] = HoldFirst; bigMesh::"PlotPoints" = "please specify PlotPoints for big mesh"; bigMesh[CylindricalPlot3D[fun_, rRange_, thetaRange_, opts___], rEnl_, thetaEnl_] := Module[{g, gNoMesh, pp, ppEnlarged, polyRadial, polyAzimuth, outerAzimuthLine, azimuthLines, radialLines}, If[(pp = PlotPoints /. Flatten[{opts}] /. Options[CylindricalPlot3D]) === Automatic, Message[bigMesh::"PlotPoints"]; Return[], ppEnlarged = Thread[(#1 #2 &)[{rEnl, thetaEnl}, pp]] ]; g = CylindricalPlot3D[fun, rRange, thetaRange, DisplayFunction -> Identity, PlotPoints -> ppEnlarged, opts]; gNoMesh = MapAt[{EdgeForm[], #} &, g, 1]; polyRadial = Partition[g[[1]], ppEnlarged[[1]] - 1]; polyAzimuth = Transpose[polyRadial]; outerAzimuthLine = With[{pts = Map[Part[#, 1, 2] &, polyAzimuth[[-1]]]}, Line[Append[pts, pts[[1]]]]]; azimuthLines = Line[Append[#, #[[1]]]] & /@ (Map[Part[#, 1, 1] &, #] &) /@ First /@ Partition[polyAzimuth, rEnl]; radialLines = Line /@ (Append[Map[Part[#, 1, 1] &, # ], Part[#[[-1]], 1, 2]] &) /@ First /@ Partition[polyRadial, thetaEnl]; Show[gNoMesh, Graphics3D[{radialLines, azimuthLines, outerAzimuthLine}], DisplayFunction -> $DisplayFunction] ] ------------------- Smooth3D -------------------- Attributes[Smooth3D] = HoldFirst; Options[Smooth3D] = {PlotStyle -> Automatic}; Smooth3D[(plotfn_)[fun_, xrng_, yrng_, opts___], xScale_, yScale_, lineopts___?OptionQ] := Module[ {stl, xstl, yst, pp, topp, ppfn, ppEnlarged, g, gNoMesh, gpoints, pointarray, xLines, yLines}, (*get option values*) stl = PlotStyle /. Flatten[{lineopts}] /. Options[Smooth3D]; pp = PlotPoints /. Flatten[{opts}] /. Options[CylindricalPlot3D]; (* deduce numeric values for PlotPoints when pp involves Automatic*) topp[gr_] := {#, #2/(# - 1) + 1} & @@ ({Length[Union[Last /@ Flatten[#, 1]]], Length[#]} &[ Cases[gr, Polygon[p_] :> p, Infinity] ]); If[! FreeQ[pp, Automatic], pp = Switch[plotfn, CylindricalPlot3D, topp at CylindricalPlot3D[x, {x, 1, 2}, {y, 1, 2}, PlotPoints -> pp, DisplayFunction -> Identity], ParametricPlot3D, topp at ParametricPlot3D[{x, y, x}, {x, 1, 2}, {y, 1, 2}, PlotPoints -> pp, DisplayFunction -> Identity], Plot3D, Dimensions[Plot3D[x, {x, 1, 2}, {y, 1, 2}, PlotPoints -> pp, DisplayFunction -> Identity][[1]]] // Reverse ]]; (*PlotPoints for smoother plot*) ppEnlarged = {xScale, yScale}(pp - 1) + 1; g = plotfn[fun, xrng, yrng, DisplayFunction -> Identity, PlotPoints -> ppEnlarged, opts ]; If[plotfn == Plot3D, g = InputForm[Graphics3D[g]][[1]]]; (*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]]; (*arrange the styles for the 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}}}]; (* the styled lines *) xLines = {Sequence @@ xstl, Line /@ (Flatten[#, 1] & /@ Partition[pointarray, 1, yScale])}; yLines = {Sequence @@ ystl, Line /@ (Flatten[#, 1] & /@ Partition[Transpose[pointarray], 1, xScale])}; (*conbine and show*) Show[gNoMesh, Graphics3D[{xLines, yLines}], DisplayFunction -> $DisplayFunction] ] -------------- Examples --------------- Problem with bigMesh: bigMesh[CylindricalPlot3D[1, {r, 2, 4}, {f, 0, Pi}, PlotPoints -> {3, 6}], 1, 3]; Corrected in Smooth3D Smooth3D[CylindricalPlot3D[1, {r, 2, 4}, {f, 0, Pi}, PlotPoints -> {3, 6}], 1, 3 ]; Smooth3D[CylindricalPlot3D[ Sin[5f], {r, 2, 4}, {f, 0, 2 Pi}, PlotPoints -> {3, 71} ], 1, 3 ]; We can use the fourth input coordinate, the style coordinate. Smooth3D[CylindricalPlot3D[ {Sin[5f], Hue[f/6Pi, .4, 1]}, {r, 2, 4}, {f, 0, 2 Pi}, PlotPoints -> {2, 71}, Lighting -> False ], 1, 3, PlotStyle -> {{Hue[0]}, {Thickness[.009], Hue[.6]}} ]; Smooth3D[ParametricPlot3D[{x, y, Sin[x + Cos[y]], {Hue[(x + y)/12, .5, 1]}} , {x, 1, 4}, {y, 1, 5}, PlotPoints -> {5, 5}, Lighting -> False], 3, 3 ]; Smooth3D[Plot3D[{Sin[x + Cos[y]], Hue[x, .4, 1]}, {x, 1, 4}, {y, 1, 5}, PlotPoints -> {5, 5}], 3, 3 ]; Smooth3D[Plot3D[Sin[x + Cos[y]], {x, 1, 4}, {y, 1, 5}, ColorFunction -> (Hue[.85 #, .6, 1] &), PlotPoints -> {5, 5}], 10, 10]; 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