Retrieving the ImagePadding in absolute units

Question

Consider the following graphic:

g = Graphics[Circle[], Frame -> True, FrameLabel -> {"one", "two"}]

Retrieving the ImagePadding by traditional means does not work:

AbsoluteOptions[g, ImagePadding]

(* ==> {ImagePadding -> All} *)

My guess for the reason behind this is that it is the Front End that can compute the actual value of the ImagePadding to use, so this can't be obtained without first rasterizing the image in the front end.

Is there some trick to get a numerical value for the ImagePadding so I can align two figures (make them have the same ImagePadding) and use an optimal value (not too small cutting off something, not too large wasting space), perhaps by asking the Front End directly?

Note that the ImagePadding is in absolute coordinates (printer's points, not plot coordinates).

Answer 1

Update

I created a paclet. Install the paclet with

PacletInstall[
    "GraphicsInformation",
    "Site"->"http://raw.githubusercontent.com/carlwoll/GraphicsInformation/master"
]

and then load the paclet with

<<GraphicsInformation`

Use GraphicsInformation instead of graphicsInformation

Original post

Here is my attempt to create a function that returns reliable values for ImagePadding, ImageSize and PlotRange. It is inspired by the efforts of @LLlAMnYP in his answer to 83636 and @AlexeyPopkov in his answer to 18034

The basic idea is use ExportPacket to find out what the FrontEnd computes for these values. Not only is this what Rasterize uses under the hood, it allows one to support Scaled ImageSize settings as well by setting the WindowSize of the Notebook object fed to ExportPacket. For instance, @Heike's answer doesn't fair well when ImageSize->Full is used.

1. ImageSize /ImagePadding - Adding an Annotation wrapper to appropriate Rectangle objects added as an Epilog can be used to determine these values.

2. PlotRange - Rather than using pure function Ticks, I used pure function GridLines. GridLines apply whether Frame/Axes are True or False.

Here is the function:

graphicsInformation[gr_Graphics] := Module[{info},
    info = Flatten @ Reap[
        Rule @@@ ReplaceAll[
            "Regions",
            FrontEndExecute @ ExportPacket[
                toNotebook[gr],
                "BoundingBox",
                Verbose->True
            ]
        ],
        _,
        #1->#2[[1]]&
    ];
    extract[info]
]

toNotebook[gr_] := Notebook[
    {
    Cell[BoxData @ ToBoxes @ instrumentGraphics[gr],
        "Output"
    ]
    },
    WindowSize -> CurrentValue[EvaluationNotebook[], WindowSize],
    Evaluator -> CurrentValue[EvaluationNotebook[], Evaluator]
]

instrumentGraphics[gr_Graphics] := Show[
    gr,
    GridLines -> {sowRange["X"], sowRange["Y"]},
    Epilog -> {
        Annotation[
            Rectangle[Scaled[{0,0}], Scaled[{1,1}]],
            "PlotRange", "Region"
        ],
        Annotation[
            Rectangle[ImageScaled[{0,0}], ImageScaled[{1,1}]],
            "ImageSize", "Region"
        ]
    }
]

sowRange[label_] := Function[Sow[{##}, label]; None]

extract[rules_] := Module[{pr, is, xr, yr},
    {pr, is, xr, yr} = {{"PlotRange", "Region"}, {"ImageSize", "Region"}, "X", "Y"} /. rules;
    {
    "ImagePadding"->Abs[is-pr],
    "ImageSize"->Abs[Subtract@@@is],
    "PlotRangeSize"->Abs[Subtract@@@pr],
    "ImagePaddingSize"->Total[Abs[is-pr],{2}],
    "PlotRange"->{xr,yr}
    }
]

Here are a couple examples:

graphicsInformation @ Plot[
    Sin[x],
    {x, 0, Pi},
    ImagePadding -> {{1.1,2.2}, {3.3,4.4}}
]

{"ImagePadding" -> {{1.1, 2.2}, {3.3, 4.4}}, "ImageSize" -> {360., 228.153}, "PlotRangeSize" -> {356.7, 220.453}, "ImagePaddingSize" -> {3.3, 7.7}, "PlotRange" -> {{-0.0654498, 3.20704}, {-0.0555556, 1.05556}}}

plot = Plot[
    Sin[x],
    {x, 0, Pi},
    ImageSize -> Full,
    ImagePadding -> {{1.1,2.2}, {3.3,4.4}}
];
graphicsInformation[plot]

{"ImagePadding" -> {{1.1, 2.2}, {3.3, 4.4}}, "ImageSize" -> {706., 441.992}, "PlotRangeSize" -> {702.7, 434.292}, "ImagePaddingSize" -> {3.3, 7.7}, "PlotRange" -> {{-0.0654498, 3.20704}, {-0.0555556, 1.05556}}}

Compare to Heike's solution:

heike[g_]:=BorderDimensions@Image[Show[g,LabelStyle->White,Background->White]]
heike[plot]

{{19, 4}, {5, 7}}

One final comment. It is possible to use a single call to ExportPacket to extract graphics information from multiple graphics objects. Since the call to ExportPacket is the most time consuming part of the code, using a single call to ExportPacket will be much quicker than using graphicsInformation on multiple Graphics objects. Here is a version that does this:

Clear[graphicsInformation, extract]
graphicsInformation[gr:{__Graphics}] := Module[{info, res},
    info = Flatten @ Reap[
        Rule @@@ ReplaceAll[
            "Regions",
            FrontEndExecute @ ExportPacket[
                toNotebook[gr],
                "BoundingBox",
                Verbose->True
            ]
        ],
        _,
        #1->#2[[1]]&
    ];
    res = extract[info] /@ Range @ Length @ gr;
    Thread @ Rule[
        {"ImagePadding", "ImageSize", "PlotRangeSize", "ImagePaddingSize", "PlotRange"},
        Thread @ ReplaceAll[
            {"ImagePadding", "ImageSize", "PlotRangeSize", "ImagePaddingSize", "PlotRange"},
            res
        ]
    ]
]
graphicsInformation[gr_Graphics] := Replace[
    graphicsInformation[{gr}],
    Rule[a_, {b_}] :> a -> b,
    {1}
]

toNotebook[gr_] := Notebook[
    {
    Cell[BoxData @ ToBoxes @ instrumentGraphics[gr],
        "Output"
    ]
    },
    WindowSize -> CurrentValue[EvaluationNotebook[], WindowSize],
    Evaluator -> CurrentValue[EvaluationNotebook[], Evaluator]
]

instrumentGraphics[gr:{__Graphics}] := MapThread[
    Show[#1,
        GridLines -> {sowRange["X" -> #2], sowRange["Y" -> #2]},
        Epilog -> {
            Annotation[
                Rectangle[Scaled[{0,0}], Scaled[{1,1}]],
                "PlotRange", #2
            ],
            Annotation[
                Rectangle[ImageScaled[{0,0}], ImageScaled[{1,1}]],
                "ImageSize", #2
            ]
        }
    ]&,
    {gr, Range@Length@gr}
]

instrumentGraphics[gr_Graphics] := instrumentGraphics[{gr}]

sowRange[label_] := Function[Sow[{##}, label]; None]

extract[rules_][k_] := Module[{pr, is, xr, yr},
    {pr, is, xr, yr} = {{"PlotRange",k}, {"ImageSize",k}, "X"->k, "Y"->k} /. rules;
    {
    "ImagePadding"->Abs[is-pr],
    "ImageSize"->Abs[Subtract@@@is],
    "PlotRangeSize"->Abs[Subtract@@@pr],
    "ImagePaddingSize"->Total[Abs[is-pr],{2}],
    "PlotRange"->{xr,yr}
    }
]

Answer 2

This almost works but seems to be 1 point off some of the time

im = Image[Show[g, LabelStyle -> White, Background -> White]];
BorderDimensions[im]

For example for

g = Graphics[Circle[], Frame -> True, FrameLabel -> {"one", "two"}, 
  ImagePadding -> {{35, 20}, {40, 50}}]

The output is

{{35, 19}, {40, 50}}

Answer 3

Edit: more seriously this time, this actually should be helpful.

---

fill = Show[#,
        Epilog -> {
          Black, Rectangle[ImageScaled[{0, 0}], ImageScaled[{1, 1}]],
          Red, Rectangle[Scaled[{0, 0}], Scaled[{1, 1}]]
        }
       ] &;

rle = Part[Length /@ Split @ #, {1, -1}] &;

imgpad[g_] := With[{dat = ImageData[fill @ g]},
  {rle @ dat[[#]], Reverse @ rle @ dat[[All, #2]]} & @@ Quotient[Dimensions @ dat, 2]
]

Usage:

imgpad[graphic]

I don't have the function BorderDimensions but I presume this could be substituted for the part after the fill.

Answer 4

This works sometimes (for framed graphics only):

absoluteImagePadding[g_] := 
 Module[{img, lines, small, big, x1, x2, y1, y2},
  img = Rasterize[Show[Graphics[{}], Sequence @@ Options[g]], "Image"];
  lines = ImageLines[ColorNegate[img], .25];
  {small, big} = 
   Sort@Cases[lines, {{_, a_}, {_, b_}} /; Abs[a - b] < 2 :> Mean[{a, b}]];
  {y1, y2} = Round[{small, ImageDimensions[img][[2]] - big}];
  {small, big} = 
   Sort@Cases[lines, {{a_, _}, {b_, _}} /; Abs[a - b] < 2 :> Mean[{a, b}]];
  {x1, x2} = Round[{small, ImageDimensions[img][[1]] - big}];
  {{x1, x2}, {y1, y2}}
  ]

It works by rasterizing the image, detecting the frame lines and measuring their position. It is an extremely hackish and fragile workaround though.