# How to get the real PlotRange of Graphics with GeometricTransformations in it?

For demonstrating the problem, have a look at the following example, and try adjusting the rotation angle a and/or the Locator position, comparing the real PlotRange of pic indicated by the frame-ticks with the one under the graph obtained by AbsoluteOptions[pic, PlotRange]:

Manipulate[
DynamicModule[{pic},
Column[{
pic = Graphics[{FaceForm[], EdgeForm[Black],
GeometricTransformation[Rectangle[], RotationTransform[a]],
Red, Point[p]},
Frame -> True],
p,
AbsoluteOptions[pic, PlotRange]
}]
],
{{a, 0}, 0, 2 Pi},
{{p, {.1, .2}}, {-2, -2}, {2, 2}, Locator}]


As shown in the screen capture above, in my Mathematica 9.0 on Windows 7 64-bit system, the PlotRange from AbsoluteOptions is not consistent with the real range. And the angle a seems to do nothing with it.

Additional tests in my system suggest this problem is not restricted on the attendance of RotationTransform, but comes with the GeometricTransformation. And it happens not only on Graphics but also on Graphics3D.

So my questions are:

• What is going on here?

• How can I obtain the real PlotRange of the Graphics/Graphics3D when there are GeometricTransformations in it?

-
I wish there was a collection with all the unexpected behaiviours of AbsoluteOptions – ssch Jan 18 at 21:01
@ssch Hmm.. I'm not sure this is a behavior of AbsoluteOptions or GeometricTransformation. After all the latter one has records too. – Silvia Jan 18 at 21:04
In previous versions AbsoluteOptions had several problems with PlotRange and Ticks (at least). – belisarius Jan 18 at 21:34
@belisarius I see.. So I have an answer to my first question. What about the second one? Is there any idea on how to get the real PlotRange? – Silvia Jan 18 at 21:37
@Silvia What does AbsoluteOptions[ListPlot[Table[Sin@x, {x, 0, 5, .05}]], PlotRange] returns in v9? – belisarius Jan 18 at 21:48

AbsoluteOptions is known as very buggy function and the bug in determining the true PlotRange has very long history...

You could try my Ticks-based workaround for getting the complete PlotRange (with PlotRangePadding added):

completePlotRange[plot:(_Graphics|_Graphics3D)] :=
Quiet@Last@
Last@Reap[
Rasterize[
Show[plot, Axes -> True, Ticks -> (Sow[{##}] &),
DisplayFunction -> Identity], ImageResolution -> 1]]

Manipulate[
DynamicModule[{pic},
Column[{pic =
Graphics[{FaceForm[], EdgeForm[Black],
GeometricTransformation[Rectangle[], RotationTransform[a]],
Red, Point[p]}, Frame -> True, PlotRangePadding -> 0], p,
AbsoluteOptions[pic, PlotRange], completePlotRange[pic]}]], {{a,
4}, 0, 2 Pi}, {{p, {.1, -.6}}, {-2, -2}, {2, 2}, Locator},
ContinuousAction -> False, SynchronousUpdating -> False]


## EDIT

One can get the exact PlotRange (without the PlotRangePadding added) with the following function:

plotRange[plot : (_Graphics | _Graphics3D)] :=
Quiet@Last@
Last@Reap[
Rasterize[
Show[plot, PlotRangePadding -> None, Axes -> True,
Ticks -> (Sow[{##}] &), DisplayFunction -> Identity],
ImageResolution -> 1]]

Manipulate[
DynamicModule[{pic},
Column[{pic =
Graphics[{FaceForm[], EdgeForm[Black],
GeometricTransformation[Rectangle[], RotationTransform[a]],
Red, Point[p]}, Frame -> True], p,
AbsoluteOptions[pic, PlotRange], plotRange[pic]}]], {{a, 4}, 0,
2 Pi}, {{p, {.1, -.6}}, {-2, -2}, {2, 2}, Locator},
SynchronousUpdating -> False]


## EDIT 2

Here is timing comparison of various ways to get real PlotRange:

completePlotRange[plot : (_Graphics | _Graphics3D)] :=
Quiet@Last@
Last@Reap[
Rasterize[
Show[plot, Axes -> True, Ticks -> (Sow[{##}] &),
DisplayFunction -> Identity], ImageResolution -> 1]]
completePlotRange[plot : (_Graphics | _Graphics3D), format_] :=
Quiet@Last@
Last@Reap[
ExportString[
Show[plot, Axes -> True, Ticks -> (Sow[{##}] &),
DisplayFunction -> Identity, ImageSize -> 1], format]]

pic = Graphics[{FaceForm[], EdgeForm[Black],
GeometricTransformation[Rectangle[], RotationTransform[.3]]},
Frame -> True];
Print[{#,
AbsoluteTiming[
First@Table[
completePlotRange[pic, #], {100}]]}] & /@ {"RawBitmap", "BMP",
"WMF", "EMF", "SVG", "PDF", "EPS"};


{RawBitmap,{5.546875,{{-0.32158,0.981396},{-0.0250171,1.27587}}}}

{BMP,{5.531250,{{-0.32158,0.981396},{-0.0250171,1.27587}}}}

{WMF,{10.093750,{{-0.32158,0.981396},{-0.0250171,1.27587}}}}

{EMF,{9.265625,{{-0.32158,0.981396},{-0.0250171,1.27587}}}}

{SVG,{7.078125,{{-0.32158,0.981396},{-0.0250171,1.27587}}}}

{PDF,{39.328125,{{-0.32158,0.981396},{-0.0250171,1.27587}}}}

{EPS,{20.656250,{{-0.32158,0.981396},{-0.0250171,1.27587}}}}

AbsoluteTiming[First@Table[completePlotRange[pic], {100}]]


{6.125000, {{-0.32158, 0.981396}, {-0.0250171, 1.27587}}}

One can see that Exporting to "RawBitmap" and "BMP" is a bit faster than Rasterize (at least in this case).

-
 Awesome, thanks! This bug has been annoying me many times, good to finally have a proper workaround. – ssch Jan 19 at 0:16 I edited to match Graphics3D too, I hope you don't mind – ssch Jan 19 at 0:26 Very nice idea +1 – Rojo Jan 19 at 0:34 Would you expect it to work on ContourPlot[Sin[x y], {x, 0, 7}, {y, 0, 2}] // completePlotRange? – chris Jan 19 at 1:03 @chris That gives correct PlotRange from the start, either way: Change Ticks to FrameTicks and you might want PlotRangePadding->0 as well, result will be for all sides, not just x and y – ssch Jan 19 at 1:26
Graphics[{GeometricTransformation[Rectangle[], RotationTransform[1.]]}]
• AbsoluteOptions[< Put the object here >, PlotRange] gives the correct PlotRange