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