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.