Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Suppose I have a bunch of graphics that I want to display in a grid:

GraphicsGrid[{
  {Graphics[Circle[], Frame -> True],
   Graphics[{Circle[], Circle[{2, 2}]}, Frame -> True]},
  {Graphics[{Circle[{5, 5}, 2], Circle[{9, 9}, 2]}, Frame -> True],
   Graphics[Circle[{100, 100}, 2], Frame -> True]}}]

1

Each graphic is roughly the same size, but the range they cover differs. You can only see this by looking at the numbers on the axes. What I'd like to do is automatically replot the graphics over the same range so that objects are correctly sized relative to each other. Something like:

2

So given an array of graphics, how would I extract all the plot ranges and determine a new plot range for each one?

share|improve this question
add comment

3 Answers 3

First figure out which plot has the largest x and y ranges:

vals = Map[PlotRange, {{Graphics[Circle[], Frame -> True],   Graphics[{Circle[], Circle[{2, 2}]},   Frame -> True]}, {Graphics[{Circle[{5, 5}, 2],   Circle[{9, 9}, 2]}, Frame -> True],   Graphics[Circle[{100, 100}, 2], Frame -> True]}}, {2}]
xrange = {Max@#, Min@#} &@vals[[All, 1]];
yrange = {Max@#, Min@#} &@vals[[All, 2]];
prange = PlotRange ->  {xrange, yrange}

Then replot

GraphicsGrid[{{Graphics[Circle[], Frame -> True],    Graphics[{Circle[],Circle[{2, 2}]}, Frame -> True, 
prange]}, {Graphics[{Circle[{5, 5}, 2], Circle[{9, 9}, 2]},
Frame -> True, prange],   Graphics[Circle[{100, 100}, 2], Frame -> True, prange]}}]

enter image description here

share|improve this answer
add comment
 grlist = {{Graphics[Circle[], Frame -> True],
       Graphics[{Circle[], Circle[{2, 2}]}, Frame -> True]}, 
     {Graphics[{Circle[{5, 5}, 2], Circle[{9, 9}, 2]}, Frame -> True], 
       Graphics[Circle[{100, 100}, 2], Frame -> True]}};

To get the plot ranges of the graphics in your list, you can use something like:

Map[PlotRange, grlist, {2}]
(* {{{{-1., 1.}, {-1., 1.}}, 
      {{-1., 3.}, {-1., 3.}}}, 
      {{{3., 11.}, {3., 11.}},
      {{98., 102.}, {98., 102.}}}} *)

Update: Re-plotting with new plot range values:

It is convenient to flatten to the list first and partition the final list before passing into GraphicsGrid. So,

 (* plot-ranges of the graphics in the flattened array *)
 PlotRange /@ Flatten[grlist]
 (* {{{-1.`,1.`},{-1.`,1.`}},{{-1.`,3.`},{-1.`,3.`}},{{3.`,11.`},{3.`,11.`}},
     {{98.`,102.`},{98.`,102.`}}}*)

 (* define new values for the plot-ranges, say: *)
 newPlotRanges = {{{-1.`, 3.`}, {-1.`, 3.`}}, {{-1.`, 3.`}, {-1.`,  3.`}},
    {{0.`, 15.`}, {0.`, 15.`}}, {{95.`, 105.`}, {95.`, 105.`}}}
 (* construct new `PlotRange`options and `ImagePadding` to help with alignments*) 
 optionslist = ({PlotRange -> PlotRange[#], ImagePadding -> 20, 
   ImageSize -> 200} & /@ Flatten[grlist]) /.
   Thread[PlotRange /@ Flatten[grlist] -> newPlotRanges];
 (* Put them altogether: *)
 GraphicsGrid[#, Frame -> True] &@ Partition[#, 2] &@
   MapThread[(#1 /. Graphics[x__] :> Graphics[x, Sequence @@ #2]) &, 
    {Flatten[grlist], optionslist}]

enter image description here

share|improve this answer
add comment

None of the answers so far are what I'm after, but they have inspired me to create my own solution:

ClearAll[reRange];
reRange[g_, o : OptionsPattern[]] :=
  Module[{ranges, rangePattern, xSpread, ySpread, reRanges},
    ranges = Map[PlotRange, g, {2}];
    rangePattern = {{xmin_?NumberQ, xmax_?NumberQ}, {ymin_?NumberQ, ymax_?NumberQ}};
    xSpread = 1.05 Max[ranges /. rangePattern -> xmax - xmin];
    ySpread = 1.05 Max[ranges /. rangePattern -> ymax - ymin];
    reRanges = ranges /. rangePattern -> 
      0.5 {{xmin + xmax - xSpread, xmin + xmax + xSpread},
           {ymin + ymax - ySpread, ymin + ymax + ySpread}};
    GraphicsGrid @ MapThread[Show[#1, PlotRange -> #2, FilterRules[{o}, Options[Graphics]]] &,
      {g, reRanges}, 2]
 ];

First we extract the plot ranges from our array of graphics (who knew PlotRange also worked as a function? - thanks kguler). Next we work out the biggest spread in x and y values, and add 5% for a bit of clearance. Then for each range, we expand to this biggest spread centred about the existing central value. Lastly we show the graphics with the new ranges.

In action:

reRange[{
  {Graphics[Circle[], Frame -> True], 
   Graphics[{Circle[], Circle[{2, 2}]}, Frame -> True]},
  {Graphics[{Circle[{5, 5}, 2], Circle[{9, 9}, 2]}, Frame -> True], 
   Graphics[Circle[{100, 100}, 2], Frame -> True]}
  }, ImagePadding -> 13]

3

For those of you playing at home, there is a bit of a catch that tripped me up for a long while. You can't seem to get the PlotRange when FilledCurves are involved:

borked = Line[RandomReal[{-100, 100}, {100, 2}]];
PlotRange @ Graphics @ borked
PlotRange @ Graphics @ FilledCurve @ borked

{{-99.2167, 97.1469}, {-95.717, 97.8384}}

{{0., 1.}, {0., 1.}}

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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