Adding labels to a GraphicsGrid object (2, with code)
- To: mathgroup at smc.vnet.net
- Subject: [mg113574] Adding labels to a GraphicsGrid object (2, with code)
- From: kj <no.email at please.post>
- Date: Wed, 3 Nov 2010 02:54:47 -0500 (EST)
- Organization: none
In <iajgse$qtg$1 at smc.vnet.net> Zach Bjornson <bjornson at stanford.edu> writes:
>Does using Labeled[(*your graphics object(s)*),(*label*)] (with its
>Alignment and Spacings options) not do what you need? It's a bit
>difficult to give advice on this (and your earlier thread) without
>example code.
OK, you asked for it! Below is a highly simplified version of the
problem, but one that hopefully captures the main difficulties.
(When you see how hairy my solution is, even after a lot of
simplification for the sake of presentation, you'll see why I was
reluctant to post it!)
The verbal descriptions (after the code) will make a lot more sense
if you first evaluate the code, so you get to see the figure that
needs to be labeled, as well as my best attempt so far. This best
attempt gets it *almost* right, but 1) the row labels are not
exactly centered on each row (the deviation is most noticeable near
the top and bottom edges of the figure), and 2) the column labels
are too far from the figure. Of course, I can apply ad hoc fudge
factors that will tweak label positions in the example, but these
fudge factors don't work in the general case (e.g., when the aspect
ratio of the individual cells is 1/3 instead of 3).
If anyone can give me a better way to position the labels *precisely*
where I want them, I'd appreciate it.
BTW, I *have* tried *many* other approaches besides this one,
including many that I was initially convinced would *obviously*
work, only to discover that they fail in unexpected ways.
Also, I didn't know how best to post code to facilitate the process
of transferring it to Mathematica for evaluation. Please let me
know if there's a better way.
TIA!
~kj
randomdata[ncols_, nrows_, nsupercols_, ar_, maxy_] :=
Module[{d}, d[1][m_] := Table[Table[m, {ncols}], {nsupercols}];
d[2] := Transpose[Table[d[1][Random[Integer, maxy]], {nrows}]];
Map[Graphics[{GrayLevel[RandomReal[{0.25, 0.75}]],
Rectangle[{0, 0}, {1, #}]}, AspectRatio -> ar] &, d[2], {3}]];
makelabels[data_] :=
Module[{codes, randomlabel},
codes = Join[Range[48, 57], Range[65, 90], Range[97, 122]];
randomlabel[pfx_] :=
pfx <> "_" <>
FromCharacterCode[
Table[RandomChoice[codes], {RandomInteger[{1, 4}]}]];
Table[randomlabel[#[[1]]], {i, #[[2]]}] & /@
Transpose[{{"T", "L", "R", "B"}, Dimensions[data][[{1, 2, 2, 3}]]}]]
makefig[data_] :=
GraphicsGrid[{GraphicsGrid[#, Spacings -> 0, Frame -> All] & /@
data}, Background -> LightBlue];
data = randomdata[10, 20, 5, 3, 200];
fig = makefig[data];
labels = makelabels[data];
mybestattempt[fig_, labels_, opts___] :=
Module[{nsupercols, nrows, ncols, dims, outerinsets, innerinsets,
row, col, localcenters, localorig, localsize, gridpoints, xs, ys,
limsx, limsy, globalsize, scaling, xform, extractcolcenters,
extractrowcenters, colcenters, supercolcenters, rowcenters, edges,
leftlabels, rightlabels, toplabels, bottomlabels, labeledfig,
core},
dims = dims = Map[Length, labels][[{1, 2, 4}]];
{nsupercols, nrows, ncols} = dims;
outerinsets = fig[[1, 2, 1]];
innerinsets = outerinsets[[1, 1, 1, 2]];
row = innerinsets[[1]];
col = #[[1]] & /@ innerinsets;
localcenters = Map[Function[list, #[[2]] & /@ list], {row, col}];
gridpoints =
Union[Flatten[
Cases[outerinsets[[1,
1]], {{Line[{{_, _}, {_, _}}]} ..}, {3}] /. Line -> List, 4]];
xs = Union[#[[1]] & /@ gridpoints];
ys = Union[#[[2]] & /@ gridpoints];
{limsx, limsy} = {Min[#], Max[#]} & /@ {xs, ys};
localorig = {(Plus @@ limsx)/2, (Plus @@ limsy)/2};
localsize = {Abs[Subtract @@ limsx], Abs[Subtract @@ limsy]};
globalsize = outerinsets[[1, 4]];
globalsize =
If[globalsize[[1]] localsize[[2]] <
globalsize[[2]] localsize[[1]],
globalsize[[1]] {1, localsize[[2]]/localsize[[1]]},
globalsize[[2]] {localsize[[1]]/localsize[[2]], 1}];
scaling = globalsize[[1]]/localsize[[1]];
xform[pt_, o_] := scaling (pt - localorig) + o;
extractcolcenters[o_] := xform[#, o][[1]] & /@ localcenters[[1]];
colcenters = extractcolcenters[#[[2]]] & /@ outerinsets;
supercolcenters = Sort[(Min[#] + Max[#])/2 & /@ colcenters];
colcenters = Sort[Flatten[colcenters]];
rowcenters :=
xform[#, outerinsets[[1, 2]]][[2]] & /@ localcenters[[2]];
rowcenters = Reverse[Sort[rowcenters]];
edges = PlotRange /. FullOptions[fig];
toplabels =
Text[#[[1]], {#[[2]], edges[[2, 2]]}, {0, -1}] & /@
Transpose[{labels[[1]], supercolcenters}];
leftlabels =
Text[#[[1]], {edges[[1, 1]], #[[2]]}, {1, 0}] & /@
Transpose[{labels[[2]], rowcenters}];
rightlabels =
Text[#[[1]], {edges[[1, 2]], #[[2]]}, {-1, 0}] & /@
Transpose[{labels[[3]], rowcenters}];
bottomlabels =
Text[#[[1]], {#[[2]], edges[[2, 1]]}, {1, 0}, {0, 1}] & /@
Transpose[{Flatten[Table[labels[[4]], {nsupercols}]],
colcenters}]; labeledfig = fig;
core = labeledfig[[1, 2]];
labeledfig[[1, 2]] =
Append[core, {toplabels, leftlabels, rightlabels, bottomlabels}];
labeledfig = Append[labeledfig, opts];
labeledfig
];
mybestattempt[fig, labels, ImageSize -> 600]
Here's a description of the functions above:
randomdata:
this is just a utility function to generate some sample "data"
(actually in for this demonstration just a bunch of rectangles is
enough); it returns an array of Graphics objects having dimensions
ncols, nrows, nsupercols;
makefig:
generates the figure that needs to be labeled from a data array
generated by randomdata; this figure is a "grid of grids"; the
"outer" grid is a 1 x nsupercols grid (i.e. a row); each element
of this outer grid is in turn an nrows x ncols grid of Graphics
objects; I call these elements "supercolumns" (the reason for this
will be apparent from the visual appearance of the figure); so, in
summary, the figure is a row of nsupercolumns supercolumns, and
each supercolumn is an nrows x ncols grid;
makelabels:
generates a list of four lists of random labels, one list for each
of the four edges of figure generated by makefig; the first list
corresponds to labels for the individual columns; these labels
should run along the bottom edge of the figure, and the text should
have direction {0, 1}; the second and third lists correspond to
labels for each row that should run along the left and right edge
of the figure, respectively; the last list correspond to the labels
for the supercolumns, and should run along the top edge of the
figure;
mybestattempt:
my best attempt so far; I don't recommend attempting to read
it/understand it. If I hadn't written it myself, I'd deem it
impenetrable. I include it only so that you get an approximate
idea of what the intended final result is. mybestattempt comes
close to it, if you look closely, the row labels are not properly
centered on each row.
In words, the label positioning should be as follows. The vertical
position of the row labels should be such that the labels are
centered on each row; furthermore the labels along the left edge
should be right-justified, and those along the right edge should
be left-justified. The horizontal position of the supercolumn
labels (which run along the top edge) should be such that the labels
are centered on each supercolumn. Similarly, the horizontal position
of the column labels (which run along the bottom edge) should be
such that the labels are centered relative to each column. Note
that, since there are ncols columns for each supercolumn, the column
labels will be repeated nsupercolumn times.