15
$\begingroup$

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).

$\endgroup$
  • $\begingroup$ to align plots i always explicitly set image padding in all plots. is there some reason you do not want to do that? $\endgroup$ – Mike Honeychurch Feb 21 '12 at 21:33
  • $\begingroup$ @Mike The question is: what padding should we use to ensure that all tick marks and labels are visible and no space is wasted? If there's a lot of label / tick / font size and style tweaking, each of those will require me to manually re-adjust the image padding. Heike's solution works quite well and spared me this (very real) trouble. $\endgroup$ – Szabolcs Feb 21 '12 at 22:00
  • $\begingroup$ ok. I understand now :) $\endgroup$ – Mike Honeychurch Feb 21 '12 at 22:42
13
$\begingroup$

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}}
$\endgroup$
  • $\begingroup$ Off by 1-2 pixels is not a big deal. The solution is still usable. Off by 6-8 would be too inaccurate. $\endgroup$ – Szabolcs Feb 21 '12 at 13:45
16
$\begingroup$

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}
    }
]
$\endgroup$
4
$\begingroup$

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.

$\endgroup$
  • 1
    $\begingroup$ You need to use ImageData to get the image data (not Part, in the bin function). The Image format changed in version 8, but ImageData works. The last number returned is incorrect and needs to be adjusted to the image height here (I get {{30, 1}, {32, 223}} instead of {{35, 1}, {32, 0}}) $\endgroup$ – Szabolcs Feb 21 '12 at 14:28
  • $\begingroup$ @Szabolcs please tell me if this is working now. $\endgroup$ – Mr.Wizard Feb 21 '12 at 14:38
  • $\begingroup$ It still doesn't work correctly. imgpad[DensityPlot[x, {x, -1, 1}, {y, -1, 1}]] gives me {{17, 1}, {13, 341}}. Sorry, really don't have time to dig into why right now ... just an example where it gives an incorrect reasult $\endgroup$ – Szabolcs Feb 21 '12 at 15:04
  • $\begingroup$ @Szabolcs your test code returns: {{31, 3}, {20, 2}} on my system. $\endgroup$ – Mr.Wizard Feb 21 '12 at 15:06
  • $\begingroup$ This should be linked from the version compatibility testing question ... I'll try to figure out what's going on later. BTW Heike's method gives {{17, 1}, {14, 0}} for the same DensityPlot $\endgroup$ – Szabolcs Feb 21 '12 at 15:08
1
$\begingroup$

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.

Mathematica graphics

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.