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.

Working on a CDF for report creation, I miss having a nice grid interface, where I would have basic operations like being able to sort a columns by clicking on the columns head (ascending and descending), or maybe group and ungroup data.

This is a great example of what can be done in Mathematica, but the code is not avaliable.

share|improve this question
1  
"but the code is not avaliable." — have you tried bribing Mike Honeychurch with some beer and upvotes? ;) –  rm -rf Mar 12 '13 at 1:23
    
@rm-rf hi! For now just upvotes! Maybe some bears if he comes into Brazil or next Wolfram Conference. :D –  Murta Mar 12 '13 at 1:42
1  
ok just noticed this. will get the code and post. –  Mike Honeychurch Mar 12 '13 at 2:07

2 Answers 2

up vote 22 down vote accepted

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]

enter image description here

share|improve this answer
    
Tks a lot! Very useful. –  Murta Mar 14 '13 at 15:14
    
...too bad this can't be used in webMathematica (as far as I can tell). You don't happen to have any experience in that regard? –  Pinguin Dirk Oct 12 '13 at 10:33
    
@PinguinDirk I've never tried it in webMathematica so don't have a feel for whether it would work and/or what changes would be needed. –  Mike Honeychurch Oct 12 '13 at 21:52
    
@MikeHoneychurch: thanks for the reply, I am currently looking into other options in this regard (jsp and friends). Thanks! –  Pinguin Dirk Oct 12 '13 at 22:18
    
Fortunately this question is not protected so I can say: great stuff, as always :) –  Kuba Apr 15 at 21:10

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

share|improve this answer
2  
Very old thread, but unfortunately still extremely relevant!... I've been waiting for a serious implementation of this, by WR, for a long time... With all the other extras one should expect: editing, referencing cell names as variables (from within or from outside), etc... –  P. Fonseca Aug 10 at 8:37
    
I agree that there is probably a gap to be filled between the raw functions provided to display material in tabulate mode and a quick flexible one. For the reasons I exposed above, however, I do not think the features you mention would be a valuable addition to the language. This would be equivalent to re-creating the Spreadsheet paradigm within Mathematica and I think my opinion on the matter has been expressed strongly enough above. The issue is the hypnotic power of the Spreadsheet, specially for my doomed generation was born under Excel, thinking it is a cool concept. To be continued... –  Trad Dog Aug 10 at 9:30
    
I have come up with this postulate regarding the use of Tabler and I keep as a credo to save me from temptation: the minimum size below which a problem can be safely treated with a spreadsheet is... zero. –  Trad Dog Aug 10 at 9:49
    
I totaly understand your arguments, but there's no faster way of creating an interface. If dynamics and manipulates are fast, the spreadsheet paradigm is instantaneous. This is probably what made it so successful. People that have no programing skills can do their own programs. No need to learn extra stuff, or ask someone to do the programming. And lets be honest, this paradigm is by far the most used in sciences and engineering (i mean, in amount of users wise). So, it can't be that bad... –  P. Fonseca Aug 10 at 10:41
    
But I don't ask for a full spreadsheet interface. Just the extremely basic stuff. What i ask is for an easy linking of the kernel to Excel. Enterprise -> free player kernel | non enterprise -> player pro kernel... (If you say spreadsheet is not for "serious" business, I add that easy linking to the cloud, is definitely not for "heavy" business). Why isn't the linking of mathematica with the most used technical calculation software in the world (me saying), the most easiest thing... –  P. Fonseca Aug 10 at 10:49

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.