How can I create an advanced grid interface?
This code is not generalized. It has been written for a specific problem but you can take it and should be able to make it a more general function -- add flexibility (e.g. add grid options) or tailor it to your needs.
ClearAll[frozenPaneGrid];
Options[frozenPaneGrid] = {"RowLabelSort" -> False};
frozenPaneGrid[tl_, tr_, bl_, br_, OptionsPattern[]] :=
DynamicModule[{scroller = 1, scrollx = 0, scrolly = 0, options,
columns = Length[tr], headings = tr, i = 1,
order = Range[Length[bl]], initialOrder = Ordering[Flatten[{bl}]]},
options = {
Background -> {None, {{White, GrayLevel[0.93]}}},
BaseStyle -> Directive[FontFamily -> "Helvetica", 11],
Frame -> False,
FrameStyle -> Directive[Thin, GrayLevel[0.75]]};
Dynamic[
Deploy@Grid[{
{Pane[
Grid[
{{EventHandler[
MouseAppearance[tl,
Framed[Style["Left Click Sort\nRight Click Reverse Sort",
9], Background -> White]], {{"MouseClicked",
1} :> (If[TrueQ[OptionValue["RowLabelSort"]],
order = initialOrder,
order = Range[Length[bl]]]), {"MouseClicked",
2} :> (If[TrueQ[OptionValue["RowLabelSort"]],
order = Reverse@initialOrder,
order = Reverse@Range[Length[bl]]])}]}},
Alignment -> {Left, Center},
Dividers -> {{1 -> White, -1 -> LightGray}, {1 -> True, -1 ->
True}},
ItemSize -> {20, 1.75},
Spacings -> {2, 0.5},
options],
{270, All},
Alignment -> {Right, Top},
ImageMargins -> 0],
Pane[
Grid[
{Table[
With[{j = j},
EventHandler[
MouseAppearance[headings[[j]],
Framed[Style[
"Left Click Sort\nRight Click Reverse Sort", 9],
Background -> White]], {{"MouseClicked", 1} :> (i = j;
order = Ordering[br[[All, i]]]), {"MouseClicked",
2} :> (i = j;
order = Reverse@Ordering[br[[All, i]]])}]], {j,
columns}]},
Alignment -> {Right, Center},
Dividers -> {{-1 -> White}, {1 -> True, -1 -> True}},
ItemSize -> {8, 1.75},
Spacings -> {{2, {0.5}, 2}, 0.5},
options],
{655, All},
Alignment -> {Left, Top},
ImageMargins -> 0,
ScrollPosition -> Dynamic[{scrollx, scroller}]]},
{Pane[
Grid[
bl[[order]],
Alignment -> {Left, Center},
Dividers -> {{1 -> White, -1 -> LightGray}, None},
ItemSize -> {20, 1.75},
Spacings -> {2, 0.5},
options],
{270, 505},
Alignment -> {Right, Top},
AppearanceElements -> None,
ImageMargins -> 0,
ScrollPosition -> Dynamic[{scroller, scrolly}]],
Pane[
Grid[
br[[order]],
Alignment -> {Right, Center},
Dividers -> {{-1 -> White}, None},
ItemSize -> {8, 1.75},
Spacings -> {{2, {0.5}, 2}, 0.5},
options],
{670, 520},
Alignment -> {Left, Top},
AppearanceElements -> None,
ImageMargins -> 0,
ScrollPosition -> Dynamic[{scrollx, scrolly}],
Scrollbars -> {True, True}]
}},
Alignment -> {{Right, Left}, Top},
Spacings -> {0, 0}],
TrackedSymbols :> {order}]
];
If you start with a grid of data and sort/reverse sort how do you recover the initial order of the 1st column? My approach here is to introduce an option "RowLabelSort" which, when False, will sort the first column according to the initial ordering.
To make this Excel like -- similar to frozen panes -- I have joined 4 grids. To get the 4 grids joined and coordinated for scrolling I "link" the scroll position in each pane. On my system (at the time was 8.0.4 and mac 10.6.8) I had to use scroller = 1 to overcome some intermittent problems.
I think the rest of the code is pretty much self explanatory. Most of the code is grid option settings for appearance. Left click on a column header to sort. Right click to reverse sort. To make this explicit I have made a big mouse appearance instruction box. You can obviously replace that.
Because I have created this on a Mac, you may find that you have to tweak some of the sizes on Windows. See this for further discussion.
Usage:
frozenPaneGrid[top left cell, rest of top row, left hand column, main body of data, options]
Test data:
SeedRandom[123];
tmp = RandomInteger[{1, 100}, {27, 14}];
frozenPaneGrid["header", Table[y, {14}],
List /@ {"Ajax", "admixes", "Acrux", "Alex", "affix", "admixtures",
"Alexei", "affixed", "admixing", "ambidextrously", "admixed",
"admix", "affixing", "ambidextrous", "Alexandrians", "Alexandria",
"Anaxagoras", "Alexandrian", "annexation", "Alexandra",
"admixture", "Alexis", "Alexanders", "annex", "affixes",
"ambidexterity", "Alexander"}, tmp,
"RowLabelSort" -> False]
Please note: these functions have been updated with some more functionality, here: See my answer here Very old thread but, since the question is formulated in a general way, I thought it could be updated with other approaches. It would be interesting to see more contributions to the topic.
Below is my one cent. I have just extended the function that I have been using for a while to add some features I realised were missing (which brought me to look how other people had tackled the problem and stumble upon this thread). The modifications involved some new code and some refactoring of the old one. The upside is that it includes some improvement from one user's experience. The downside is that, although the code went through some testings, I have not used it extensively enough to guarantee it is satisfactorily bug free.
First, a bit of rambling about what drove the design (the reader is warned that this paragraph can and should probably be skipped). Tablers (even prior to their electronic implementation) are in my humble opinion both a flawed and low level concept – to the extent that one could jokingly question whether Dan Bricklin and later Mitch Kapor have made an overall positive contribution to Computer Science and Humanity in general by bringing the concept to the digital world. The seminal flaw is that any input in a Tabler is actually a duplicated entry: it introduces both a semantics and a geographic definition (the position of the cell in the table). Since duplication prevents any scale up, that original sin may very well explains where billions of development in the Financial industry have been lost over the past 20 years. As importantly, it is a very low level concept in the sense that I believe is not adapted to the way human beings process information and generate ideas (with the exception likes of von Neumman – but according to Fermi, Hungarians came from another planet and should not be classified as Earthlings). The idea that we process long lists to find outliers or patterns seems to be entirely at odd with what psychological studies reveal of the way humans work when confronted with large chunks of data. At least in my case, when dealing with a long list, I do look at the first elements; on exceptionally productive days, I have the good idea to check also the last one. And occasionally – mostly at gun point, I dig deep and browse through a few elements in the middle of the list. The structure of the table, however, is a compelling pattern and an unavoidable one when it comes to presenting results. The issue of tablers is that instead of bringing the pattern at the very end of the processing stage, they cripple the user by imposing it all along.
After this digression, here is what I came up with. If there was only one idea I would try to defend in all this, it is the deliberate effort to separate the static and interactive parts. The first function is actually the core one. It is the work-horse that does all the type-setting and delivers a final, static output, usable in traditional documents (think printed ones or PDF). The second function is just an instance of how interactivity can make use of the core function to let you investigate the data. Sorting is indeed a good idea. I'll probably try to incorporate it.
First the static function:
Options[DisplayTableWithHeaders] = {
HeadersCols -> {},
HeadersRows -> {},
Title -> "",
SelectItems -> All,
SelectRows -> False,
SelectCols -> All,
NbRows -> 3,
NbCols -> 3,
BuilderHeaderRows -> (First[#2] &),
BuilderHeaderCols -> (First[#2] &),
ColorBckGrd -> GrayLevel[0.5`],
ItemStyle -> {{Directive[FontFamily -> "Helvetica",
FontWeight -> Bold, FontSize -> Medium],
None}, {Directive[FontFamily -> "Helvetica", FontWeight -> Bold,
FontSize -> Medium],
None}, {{1, 1} -> Directive[FontSize -> Medium], {1, 2} ->
Directive[FontWeight -> Bold]}}, ItemSize -> Full,
Alignment -> {{Left, Center}, {Center, Center}},
Dividers -> LightGray};
DisplayTableWithHeaders[values2D_, opts : OptionsPattern[]] :=
Block[{optSelectItems, optFctCreateHeadersRows, headersrows,
headerscols, linemissingitems, colmissingitems, itemsFinal,
optNbRows, colourbckground, optBackGround, optSelectCols,
locHeadersCols, locHeadersRows, locTitle, optNbCols, locdims},
locHeadersCols =
HeadersCols /. Flatten[{opts, Options[DisplayTableWithHeaders]}];
locHeadersRows =
HeadersRows /. Flatten[{opts, Options[DisplayTableWithHeaders]}];
locTitle =
Title /. Flatten[{opts, Options[DisplayTableWithHeaders]}];
colourbckground =
ColorBckGrd /. Flatten[{opts, Options[DisplayTableWithHeaders]}];
optBackGround =
Background -> {{colourbckground,
None}, {colourbckground, {Lighter[colourbckground, 0.3`],
Lighter[colourbckground, 0.6`]}}};
optNbRows = OptionValue[NbRows];
optNbCols = OptionValue[NbCols];
optSelectItems =
SelectRows /. Flatten[{opts, Options[DisplayTableWithHeaders]}];
If[\[Not] optSelectItems,
optSelectItems =
SelectItems /. Flatten[{opts, Options[DisplayTableWithHeaders]}]];
optSelectCols =
SelectCols /. Flatten[{opts, Options[DisplayTableWithHeaders]}];
optFctCreateHeadersRows =
BuilderHeaderRows /.
Flatten[{opts, Options[DisplayTableWithHeaders]}];
(* If headers are not provided, they are generated automatically.
The default policy is the position of the items in both direction *)
\
If[locHeadersRows != {},
headersrows = locHeadersRows,
headersrows = MapIndexed[optFctCreateHeadersRows, values2D]
];
If[locHeadersCols != {},
headerscols = locHeadersCols,
headerscols =
MapIndexed[optFctCreateHeadersRows, values2D\[Transpose]]
];
linemissingitems = Table["...", {Length[First[values2D]]}];
itemsFinal = values2D;
Switch[optSelectItems,
All, itemsFinal = values2D,
"StartEnd",
If[optNbRows < Floor[Length[values2D]/2],
itemsFinal =
Join[Take[values2D, optNbRows], {linemissingitems},
Take[values2D, -optNbRows]];
headersrows =
Join[Take[headersrows, optNbRows], {"..."},
Take[headersrows, -optNbRows]];
],
"EveryOther",
If[optNbRows < Length[values2D],
itemsFinal =
Riffle[Extract[values2D,
Table[{i}, {i, 1, Length[values2D],
optNbRows}]], {linemissingitems}];
headersrows =
Flatten[Riffle[
Extract[headersrows,
Table[{i}, {i, 1, Length[values2D], optNbRows}]], {"..."}]];
]
,
_List,
itemsFinal =
Extract[values2D,
Flatten[Position[headersrows, #]] & /@ optSelectItems];
headersrows = optSelectItems;
];
colmissingitems =
Table["...", {Length[First[Transpose[itemsFinal]]]}];
Switch[optSelectCols,
All,
itemsFinal = itemsFinal
,
"StartEnd",
If[optNbCols < Floor[Length[itemsFinal\[Transpose]]/2],
itemsFinal =
Join[Take[itemsFinal\[Transpose], optNbCols], {colmissingitems},
Take[itemsFinal\[Transpose], -optNbCols]]\[Transpose];
headerscols =
Join[Take[headerscols, optNbCols], {"..."},
Take[headerscols, -optNbCols]];
]
,
"EveryOther",
If[optNbCols < Length[itemsFinal\[Transpose]],
itemsFinal =
Riffle[Extract[itemsFinal\[Transpose],
Table[{i}, {i, 1, Length[itemsFinal\[Transpose]],
optNbCols}]], {colmissingitems}]\[Transpose];
headerscols =
Flatten[Riffle[
Extract[headerscols,
Table[{i}, {i, 1, Length[values2D\[Transpose]],
optNbCols}]], {"..."}]]
]
,
_List,
itemsFinal =
Extract[itemsFinal\[Transpose],
Flatten[Position[headerscols, #]] & /@
optSelectCols]\[Transpose];
headerscols = optSelectCols;
];
locdims = Dimensions[itemsFinal];
Which[locdims == {1, 1},
(*Print["Ce point est atteint: ",{Join[{Join[{locTitle},
headerscols]},{Join[headersrows,Flatten@itemsFinal]}]}];*)
Grid[Join[{Join[{locTitle}, headerscols]}, {Join[headersrows,
Flatten@itemsFinal]}],
FilterRules[
Flatten[{opts, optBackGround,
Sequence @@ Options@DisplayTableWithHeaders}], Options[Grid]]
]
,
True
,
Grid[
Join[{Join[{locTitle},
headerscols]}, (Join[
Transpose[{PadRight[headersrows, Length[#1], Null]}], #1,
2] &)[itemsFinal]],
FilterRules[
Flatten[{opts, optBackGround,
Sequence @@ Options@DisplayTableWithHeaders}], Options[Grid]]
]
]
];
Now one example of dynamic use of the previous function. This one is rather poor. For a start, the code is flawed and I would appreciate if one the talented individuals that are active on this forum had miraculously read that far and would be kind enough to help correcting it. For some reason, I could not make the variable controlCols and controlRows local in Manipulate. Besides, the function signature is at odd with the one's it calls: I am fully aware and certainly not proud of it but I have grown accustomed to it over time and could not find the motivation to come up with a better design.
DisplayTableLive[results_, headerscols_: {}, columnPickerCols_: True,
headersrows_: {}, columnPickerRows_: False,
opts : OptionsPattern[]] :=
Module[{(*nbRows, nbCols, selRows, selCols, controlRows, controlCols*)},
controlCols = If[columnPickerCols,
{{selCols, headerscols, "Select cols from:"}, headerscols,
ControlType -> TogglerBar},
Sequence @@ {{{selCols, "StartEnd", "View cols:"},
{All, "StartEnd", "EveryOther"}}, {{nbCols, 1,
"Number cols for display:"}, 1, Length[results\[Transpose]],
1}}
];
controlRows = If[columnPickerRows,
{{selRows, headersrows, "Select rows from:"}, headersrows,
ControlType -> TogglerBar},
Sequence @@ {{{selRows, "StartEnd", "View rows:"},
{All, "StartEnd", "EveryOther"}}, {{nbRows, 1,
"Number of rows for display:"}, 1, Length[results], 1}}
];
Manipulate[
DisplayTableWithHeaders[results,
HeadersCols -> headerscols,
HeadersRows -> headersrows,
SelectRows -> selRows,
NbRows -> nbRows,
NbRows -> If[columnPickerRows, 1, nbRows],
SelectCols -> selCols,
NbCols -> If[columnPickerCols, 1, nbCols],
FilterRules[Flatten[{opts}], Options[DisplayTableWithHeaders]]
],
Evaluate[controlRows],
Evaluate[controlCols]
]
]
Finally, some examples, to try to mitigate the absence of formal documentation:
m = Table[i + j, {i, 10, 100, 10}, {j, 11}]
DisplayTableWithHeaders[m, SelectRows -> "StartEnd", NbRows -> 3,
SelectCols -> "EveryOther", NbCols -> 4]
DisplayTableWithHeaders[{{a}}, SelectRows -> "EveryOther",
NbRows -> 3, SelectCols -> "StartEnd", NbCols -> 3]
DisplayTableWithHeaders[IdentityMatrix[3],
HeadersRows -> {"Kolmogorov", "Milanković", "Borel"},
HeadersCols -> {"Andrej", "Milutin", "Émile"}, SelectRows -> All,
SelectCols -> All, Title -> "MTV Guests"]
DisplayTableWithHeaders[m, SelectRows -> {1, 5}, SelectCols -> {3, 4}]
Some examples of interactive use:
DisplayTableLive[m, Range[11], True]
DisplayTableLive[
IdentityMatrix[3], {"Andrej", "Milutin",
"Émile"}, True, {"Kolmogorov", "Milanković", "Borel"}, True,
Title -> "MTV Guests"]
Hope it can be of some use.
Best