4

In the code below a hexagonal shape is defined and plotted. The ParametricPlot3D shows the hexagonal design almost as intended. However, the mesh makes some strange "wires" to x=y=0. This is unexpected as the function does not exist at these coordinates. Why am I seeing this strange behaviour at the center? How can the plot be improved?

I tried several things: 2nd plot: I also included these coordinates in the Exclusions in the second plot but this didn't help.

3th plot: When the mesh is not plotted the graph looks better, altough some polishing at the edges might improve the graph further.

4th plot. Other problems is encoutered in the 3Dplot.

 Remove["Global`*"];
 func[u0_, v0_] := Module[{u = u0, v = v0},
   {
    u, v,
    If[u == 0 && v == 0,
     Null,
     θ  = ArcTan[v, u];
     θN = Mod[θ, 3.1415/3., -3.1415/6.](*θ w.r.t North*);
     l  = Norm[{u, v}];
     vN = l*Cos[θN ];
     If[.3 < vN < .8, 2 - vN, Null] (*Make parabolic function(vN)*)
     ]
    }
   ]

 func[0., 0.]

 surfacePlot = 
  ParametricPlot3D[func[u, v], {u, -1, 1}, {v, -1, 1}, 
   PlotRange -> All, AxesLabel -> {"x", "y", "z"}, PlotRange -> All]

 surfacePlot = 
  ParametricPlot3D[func[u, v], {u, -1, 1}, {v, -1, 1}, 
   PlotRange -> All, AxesLabel -> {"x", "y", "z"}, PlotRange -> All, 
   Exclusions -> {u == 0, v == 0}, ExclusionsStyle -> {None, Red}]

 surfacePlot = 
  ParametricPlot3D[func[u, v], {u, -1, 1}, {v, -1, 1}, 
   PlotRange -> All, 
   AxesLabel -> {"x", "y", "z"},(*Exclusions\[Rule]{{u\[Equal]0,
   u<.1}},*)PlotPoints -> 80, Mesh -> None]

 surfacePlot = 
  Plot3D[func[u, v][[3]], {u, -1, 1.4}, {v, -1, 1.4}, PlotRange -> All,
    AxesLabel -> {"x", "y", "z"}, PlotRange -> All, 
   PlotPoints -> { 30}]

Plots of strange wires to u=v=x=y=0

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
LvD
  • 55
  • 5

1 Answers1

7

Your mapping is not continuous and the mesh just shows it.

fun1[u_, v_] := 2 - Norm[{u, v}]*Cos[Mod[ArcTan[v, u], Pi/3, -Pi/6]]
ParametricPlot3D[{u, v, fun1[u, v]}, {u, -1, 1}, {v, -1, 1}, 
                 RegionFunction -> (1.2 < fun1[#4, #5] < 1.7 &), PlotPoints -> 50]

Mathematica graphics

Dr. belisarius
  • 115,881
  • 13
  • 203
  • 453
  • Your suggestion resulted in this improved figure with a more continuous mesh: http://i.stack.imgur.com/pIyKA.png. However, the edges are still not very sharp. Any ideas on how to improve this?

    Is there another/better way to define the edge coordinates?

    fun1[u_, v_] := 2 - Norm[{u, v}]*Cos[Mod[ArcTan[v, u], Pi/3, -Pi/6]]; ParametricPlot3D[{u, v, fun1[u, v]}, {u, -1, 1}, {v, -1, 1}, RegionFunction -> (1.2 < fun1[#4, #5] < 1.7 &), PlotPoints -> 100, MeshFunctions -> {ArcTan[#5, #4] &, (Sqrt[#4^2 + #5^2]*Cos[Mod[ArcTan[#5, #4], Pi/3, -Pi/6]] &)} ]

     – LvD Dec 23 '14 at 19:57
  • @LvD I believe the better alternative is to draw six polygons instead of a Plot ... – Dr. belisarius Dec 23 '14 at 20:00
  • Thanks @belisarius.

    I really need to use the defined function; a polygon is not a suited alternative. Actually, the function I want to plot is more complicated that the planes as I posted here. By using the RegionFunction and a high number of plotpoints I got the following result: http://i.stack.imgur.com/3YmgL.png

     – LvD Dec 23 '14 at 21:11
  • @LvD Well, yes.Increasing PlotPoints and MaxRecursion you can always try to fill the gaps if you don't zoom too much. Thanks for the accept! – Dr. belisarius Dec 23 '14 at 21:38