MathGroup Archive 1999

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

Search the Archive

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






  • Prev by Date: Re: Mathlink connection to Spyglass/Fortner Transform
  • Next by Date: Re: Re: Orderless indexed functions
  • Previous by thread: Re: Mathlink connection to Spyglass/Fortner Transform
  • Next by thread: MathLink Data Types