AbsoluteOptions not working with PlotPoints?

Question

AbsoluteOptions does not work well with PlotPoints, for example:

AbsoluteOptions[
 Plot3D[Sin[x y], {x, 0, 2}, {y, 0, 2}, Mesh -> All,
   MaxRecursion -> 1], PlotPoints]

Known bug?

Answer 1

It was never supposed to work, even in old Mathematica. AbsoluteOptions[] was only ever intended to get settings corresponding to options of Graphics[] or Graphics3D[], since that information can be pulled from the Graphics[]/Graphics3D[] thus generated.

MemberQ[Keys[Options[Graphics3D]], PlotPoints]
   False

Logically, it also makes sense: recall that Plot3D[] samples adaptively, starting from an initial sampling (which is exactly what PlotPoints controls!), and in the final mess of Polygon[] objects that results, there is no way to distinguish which were the initial sampling points, and which were the points added by the adaptive sampling.

With that all being said, do ponder on the following results:

p1 = Cases[Plot3D[Sin[x y], {x, 0, 2}, {y, 0, 2},
                  Mesh -> All, MaxRecursion -> 1], 
           GraphicsComplex[pts_, rest__] :> pts, ∞];

p2 = Cases[Plot3D[Sin[x y], {x, 0, 2}, {y, 0, 2},
                  Mesh -> All, MaxRecursion -> 1, PlotPoints -> 15], 
           GraphicsComplex[pts_, rest__] :> pts, ∞];

p1 === p2
   True

Answer 2

AbsoluteOptions[Plot3D[..], opt] can only return options to Graphics3D, as is pointed out in J.M.'s answer.

Here's a way to reverse engineer a PlotPoints setting from the output of Plot3D. It relies on Plot3D continuing to do things internally in the same way it has for a while, namely, adding the points to GraphicsComplex in the order they are evaluated, starting with the initial sampling grid. Caveat: This does not work if the function as a singularity on the grid. Since Plot3D makes slight offsets to the grid along the boundary, this usually only happens if the function and plot domain have symmetries that coincide at a singularity (e.g., change {x, 0, 2} to {x, -1, 1} below).

plot = Plot3D[Csc[x y], {x, 0, 2}, {y, 0, 2}, Mesh -> All,
   PlotPoints -> {9, 16}, MaxRecursion -> 1];
pts = Cases[plot, GraphicsComplex[p_, ___] :> p, Infinity];
struct = SplitBy[Flatten[pts, 1], #[[2]] &];
xpts = Length /@ struct;
ypts = Length /@ Split[xpts];
PlotPoints -> If[First[xpts] == First[ypts],
  First[xpts],
  {First[xpts], First[ypts]}]

(*  PlotPoints -> {9, 16}  *)

For the curious, here are xpts and ypts from which PlotPoints was inferred:

xpts

(*
{9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 2, 3, 3, 3, 3, 5, 6, \
6, 5, 5, 5, 5, 4, 5, 5, 1, 1, 1, 2, 2, 1, 1, 1, 2, 1, 1, 1, 1, 1, 3, \
...
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}
*)

ypts

(*
{16, 1, 4, 1, 2, 4, 1, 2, 3, 2, 3, 1, 5, 1, 6, 1, 5, 1, 6, 1, 1, 1, \
8, 1, 35, 1, 13, 1, 13, 1, 8, 1, 1, 11, 1, 10, 1, 11, 1, 6, 1, 1, 14, \
2, 2, 1, 4, 4, 1, 15, 1, 4, 1, 3, 1, 1, 2, 7, 1, 1, 1, 3, 1, 82, 1, \
34, 1, 257}
*)

Answer 3

The built-in AbsoluteOptions does not knwo MaxRecursion either. There is message page for this: optnf.

On the documentation page for Plot3D there is a section Plot3D Scope>Sampling give a short idea of what is actually done by Plot3D.

Use PlotPoints and MaxRecursion to control adaptive sampling:

Grid[Table[
  Plot3D[Sin[x y], {x, 0, 4}, {y, 0, 4}, PlotPoints -> pp, 
   MaxRecursion -> mr, Mesh -> None], {mr, {0, 1, 2}}, {pp, {5, 15}}]]

There is ome further insight with the example on that page for Options>MaxRecursion and Options>PlotPoints both with Sin.

There is a documentation page for PlotPoints and for MaxRecursion. The later is insightful on how to cope with adaptive sampling or subdivision:

Table[Plot[Sin[x^2], {x, 0, 10}, PlotPoints -> 5, 
  MaxRecursion -> mr], {mr, {0, 2, 4, 6}}]

This may be continued on EvaluationMonitor:

Count evaluations for doing a surface plot:

f[x_, y_] := E^x - Sin[x^3 - 3 y];
Block[{c = 0}, 
 Plot3D[f[x, y], {x, -2, 2}, {y, -2, 2}, EvaluationMonitor :> c++, 
  PlotLabel :> ToString[c] <> " evaluations"]]

And the main tipps on how to enhance performance:

When the function is evaluated, it takes fewer evaluations since symbolic derivatives are used:

Block[{c = 0}, 
 Plot3D[Evaluate[f[x, y]], {x, -2, 2}, {y, -2, 2}, 
  EvaluationMonitor :> c++, 
  PlotLabel :> ToString[c] <> " evaluations"]]

This can be done for some further extension by taking the tipps into account form the section Generalization & Extions on the documenation page for EvaluationMonitor. This is hard numerical calculation and computer time overhead then. Most of EvaluationMonitor is about Your questions intents. Some hints can be found on the documation page for StepMonitor too. That might be the more direct path for optimization by hand. These lines example has found some question on the community already.

{sol, steps} = 
  Reap[NDSolve[{D[u[t, x], t] == D[u[t, x], x, x], u[0, x] == 0, 
     u[t, 0] == Cos[6 \[Pi] t], (D[u[t, x], x] /. x -> 1) == 0}, 
    u, {t, 0, 1}, {x, 0, 1}, 
    StepMonitor :> 
     Sow[ParametricPlot3D[{t, x, u[t, x]}, {x, 0, 1}]]]];

splot = Show[steps, PlotRange -> All, BoxRatios -> {1, 1, 0.4}]

The methodologies incorporated into the built-ins of Graphics3D are already enhanced and optimized. The goals are suitablitity for most cases and as suitable as possible information about the represented surfaces and curves. This uses prettea enthance methods not all tought at universities at all at present times. That does not imply that this is not high inferential reasoning. It can not be optimal by one method in general.

That is for the intent of the question nice surfaces with Plot3D.

Why does this not work with AbsoluteOptions? Now the only example for AbsoluteOptions with Plot-built-ins is with Plot. There is no information about Scope or Options. See Also list AbsoluteCurrentValue, that is about attributes of EvaluationNotebooks, FullGraphics and SetOptions. That is not much.

FullGraphics does not work with Graphics3D only with Graphics. InputForm works with Graphics3D. SetOptions is not for getting information but for setting option values.

In the tutorial Efficient Representation Of Many Primitives there is the statement:

The output of Plot3D is a GraphicsComplex! That is in antinomy to the output of the built-in InputForm. In the paragraph ahead this statement is this:

GraphicsComplex is especially useful for representing meshes of polygons. By using GraphicsComplex, numerical errors that could cause gaps between adjacent polygons are avoided.

So the representation of a surface is mesh of polygons that is brought into the notebook via GraphicsComplex. Now there reason to count points or polygons or search for gaps.

For points questions are:

collinear points coincident points find intersection points extracting points from the meshfunctions of plot3d

and many more.

The latter already show lines and polygons.

For lines:

extracting mesh lines from a graphicscomplex

r = RevolutionPlot3D[{ x-0.2,-2 x},{x,0.7,1},
  Boxed->False,
  Axes->False,
  Mesh->{8,4}
]
r[[1,1,1,2]]

lines = Cases[Normal[r], _Line, Infinity];

Graphics3D[lines]

r/. GraphicsComplex[p_, g_, o___] :> 
  GraphicsComplex[p, Cases[g, _Line, Infinity]]

For polygons:

how can i find the vertexes of a polygon

Grid[{{"image", "Points", "Lines", 
   "Polygons"}, {PolyhedronData["Cube"], 
   PolyhedronData["Cube", "Points"], PolyhedronData["Cube", "Lines"], 
   Short[PolyhedronData["Cube", "Polygons"], 10]}}, 
 Spacings -> {1, 1}, Dividers -> All, Alignment -> {Center, Top}]

Real surfaces are really complex so a simplified example:

Generation:

    points = {{0, 0, 0}, {0, 0, 300}, {0, 300, 300}, {0, 300, 
       0}};(*Vertices of the polygon*)
myPolygon = 
     Graphics3D[{Polygon[points]}, Boxed -> False, Lighting -> {Gray}];

Analysis:

pointsana=Cases[myPolygon, Polygon[pts_] -> pts, Infinity]

Check:

points==pointsana

(* True *)

Cases[myPolygon, Polygon[pts:{{_,_,_}..}] -> pts, Infinity]

might be more powerful.

Cases[myPolygon, {x_?NumericQ, y_?NumericQ, z_?NumericQ}, Infinity]

suffices too.

So the simply answer for Your very question is:

Since the complexity of a 3D graphics can be high lists are not considered suitable for the analysis of Graphics3D by Wolfram Inc.!

A suitable analysis may be given by this very persons:

coloring a set of polygons each polygon to have a specific color

data2D = Import["http://pastebin.com/raw.php?i=0Liw8F1r", "NB"];
data4D = Import["http://pastebin.com/raw.php?i=zgrCRiQh", "NB"];

Graphics3D[
 GraphicsComplex[
  data4D[[;; , 1 ;; 3]], {Yellow, EdgeForm[], Polygon /@ tri}], 
 Boxed -> False, AspectRatio -> 1, BoxRatios -> Automatic, 
 SphericalRegion -> True, , ImageSize -> Large, 
 PlotRange -> 0.9 {{-1, 1}, {-1, 1}, {-0.5, 0.5}}]

This is the 3D extension of a famous mathemtical problem coloring a set of 2d patches differently. There might be no solution already in 2D.

Since we have a surface that is not enought we need more knowledge for example the orientation of the surface by surface normals, the continuity of the surface, first and second derivative and much more.

For examaple this question:

easy way to export graphics3d as triangles with vertexnormals/ in each vertex of the polygons. This can be done better.

Some extension is this answer plot extract data to a file. So instead of working with AbsoluteOptions it is suitable to work with Cases and pattern and analyze without low inferential complexity with ListPlot3D[extractedatatype, BoxRatios -> Automatic]. It works with GraphicsComplex[p_, __], GraphicsComplex[p_, __]. For more GraphicsComplex es

Cases[
      Normal[gr3Dmulti], 
      GraphicsGroup[g_] :>
         Cases[g, Polygon[p_, __] :> p, -4

]

is appropriate. And is this Cases[First@gr, Line[data_] :> data, -1] works too.

Polygon, Line and Point do it for the named data type.

A nice start of the problems arising in depth is findinga concave hull and figuring the problem more closer in meshing the surface of a non convex object. Normals are not so easy, but orientation is a hard problem.

To digg deeper into the topic conduct searches like surface characterisation higher moments on google.

Think later von description for surface with these

surface features.

from this reference: Morphometric Characterisation. My answer was focussed very much on stackexchange. For the adaptive sampling look at the literature. For exmample a newer work On properties of analytical approximation for discretizing 2D curves and 3D surfaces and references therein. Or look at how-to-obtain-adaptive-sampling-as-in-plot-function. This source has some remarks on how Mathematica internally handles highly oscillatory behavior. It really recognized algorithmically such cases.

The algorithm make use of InterpolatingFunction.

SystemOpen@FindFile["DifferentialEquations`InterpolatingFunctionAnatomy`"]

brings up the package for InterpolatingFunction.

This simple example works for the data set extracted for points from Graphics3D in the parameter data. But this may be very long. It might replace the built-in for very low inferential purposes.

In this quesiton an attempt is made how to do this reverse: how to splice together several instances of InterpolatingFunction

This is nice:

interp = Interpolation@Table[{i, Sin[i]}, {i, 0, Pi, 0.1}]; (Dataset[{Prepend[#, "InterpolatingFunction"], Prepend[Partition[f1 /@ #, 1], f1]}] &@ Drop[f1["Methods"], {-8, -8}])

instead of just use Plot or Plot3D.

This is already really big.

Another simple suggestion:

Grid[{{"InterpolatingFunction", "Domain", "Coordinates", "Grid", 
   "ValuesOnGrid", "InterpolationOrder", "DerivativeOrder"}, 
  Prepend[Table[{i, Interpolation[{1., 2., 3., 4.}][[i]]}, {i, 1, 5}],
    Interpolation[{1., 2., 3., 4.}]]}]

So I answer, do not attempt to analyze the visual output to exhaust entents. Prefer to optimize the adaptive sampling with the options PlotPoints and MaxRecursion. What You choice to input and run is not what is realized by Mathematica, but it influences strongly what is in the output. This due to the fact that the surface represents by intent the real surface and is not the real surface. The target is to show the surface as smooth as possible and without any broken points, lines or polygons.

That is not always achieved. Besides the two options mentions there are the there parameters for exactness that influence the results. It is a time consuming process to find the optimum and many bother and stay angry about the results. Some have bigger display, some less good eyes to see, but the representation is what it is with Mathematica. That good not bad.

The concepts are closed in the design of Mathematica as long as the inference levels are low. Plot3D and Graphics3D include higher inference levels. This limits the univerality and to keep the price for packages in total low, the checkes, proves and logic falls somewhat short.

This can be overcome by personal efforts and one acquires knowledge. Whether this leads to particular high selfesteem - I do not know. The presented workup is intermediate and high in inference and tediousness already, but does not do much with the complexity and depth of the problems implicit to the question. Not it is not a bug, this is misuse of the built-in AbsoluteOptions. That is not documented in Mathematica. I do not know if this is anywhere documented. I have just a smaller V12.0.0.

To drive this on step further a reference to DiscretizeRegion and How to improve this Plot? and the Gibb's phenomenon referenced there. Keep in mind that the Piecewise built-in is for some purposes dangerous in Mathematica, one of them is NDSolve. But the Solve group of the built-ins do not work nicely with Piecewise.

Piecewise is in need to be defined well for the individual purposes in Mathematica! Dangers are time-consuming and less smoothness. See UnitStep and Piecewise. But Piecewise is needed to specify that x is real, use inequalities in the first condition. There are several questions in this community address such problems.

So refinement and adding normals are suitable methods for better results in Graphics and Graphics3D. That should be the mid level inference solution to the question. That is somewhat already implemented with the methods PlotPoints and MaxRecursion.