Skip to main content

manipulate - How can I add column-rearrangement-by-mouse-dragging to my dataset display function?


A subject that I seem to take at heart...


I was expecting an upgrade of the default Dataset display in MMA 10.3.1. It did not happen. Among the features I would have liked to see improved is a better/easier control of the number of items displayed. Also, the default behaviour displays only the first few rows. Why not the beginning and the end of the Dataset ? Or some rows in the middle.
I have thus upgraded the code in: Show More Rows of Dataset.



You can read some rambling about tabular data, their handling and the consequent design of the original functions (the post predates Datasets in MMA but it is still valid) in: How can I create an advanced grid interface?.


The new code has a few new functionality but it is mostly improving on the handling of border cases. It is far from perfect. In particular, no attention was paid to efficiency on very large data sets. The code stops relying on the Dataset functionality for sorting and filtering: essentially because I did not know how to sort on several columns at the same time directly in Dataset whereas a solution is easily available for plain matrices through Ordering.


Now, for the question itself (because there is one !). The dynamic function DisplayDatasetLive does pretty much everything I consider essential for a on-the-fly processing of datasets except for one point: I'd really like to be able to re-arrange my column through mouse dragging. I could not figure out a way of doing this in MMA but maybe some of the wizards on this forum have a suggestion...


Best


Trad


PS: some part of the implementation were solved thanks to post from this very forum. I should have thought of recording the reference so as to give explicit credit to their authors. They will recognise themselves and I am happy to do it as I find these back again.


(* A function to assess whether an expression is a function. Suggested by someone on this forum *)
FunctionQ[_Function|_InterpolatingFunction|_CompiledFunction]=True;
FunctionQ[f_Symbol]:=Or[DownValues[f]=!={},MemberQ[Attributes[f],NumericFunction]]
FunctionQ[_]=False;


(* The workhorse function: display standard tabular data *)
Options[DisplayTableWithHeaders]={HeadersCols->{},HeadersRows->{},TitleTable->"",
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],Non‌​e},{{1,1}->Directive[FontSize->Medium],{1,2}->Directive[FontWeight->Bold]}},ItemS‌​ize->Full,Alignment->{{Left,Center},{Center,Center}},Dividers->LightGray, SortCols->{},ReverseSort->False, ReturnHeaders->False};

DisplayTableWithHeaders[values2D_,opts:OptionsPattern[]]:=Block[{optSelectItems,optFctCreateHeadersRows,optFctCreateHeadersCols,headersrows,headerscols,linemissingitems,colmissingitems,itemsFinal,optNbRows,colourbckground,optBackGround,optSelectCols,locHeadersCols,locHeadersRows,locTitle,optNbCols,optSortCols, locdims,optReverseSort},locHeadersCols=HeadersCols/.Flatten[{opts,Options[DisplayTableWithHeaders]}];
locHeadersRows=HeadersRows/.Flatten[{opts,Options[DisplayTableWithHeaders]}];
locTitle=TitleTable/.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]}];
optSortCols = OptionValue[SortCols];
optReverseSort = OptionValue[ReverseSort];
If[\[Not]optSelectItems,optSelectItems=SelectItems/.Flatten[{opts,Options[DisplayTableWithHeaders]}]];
optSelectCols=SelectCols/.Flatten[{opts,Options[DisplayTableWithHeaders]}];
optFctCreateHeadersRows=BuilderHeaderRows/.Flatten[{opts,Options[DisplayTableWithHeaders]}];
optFctCreateHeadersCols=BuilderHeaderCols/.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*)
(*Print["First transpose"];*)
headersrows=If[locHeadersRows!={},locHeadersRows,MapIndexed[optFctCreateHeadersRows,values2D]];(*Print["locHeadersRows",locHeadersRows];Print["headersrows",headersrows];*)
If[Head[locHeadersCols]=!=List,locHeadersCols={locHeadersCols}];
(*Print["locHeadersCols",locHeadersCols];*)
headerscols=If[locHeadersCols!={},locHeadersCols,If[MatrixQ[values2D],MapIndexed[optFctCreateHeadersCols,values2D\[Transpose]],{optFctCreateHeadersCols[values2D,{1}]}]
];
(*Print["headerscols: ",headerscols];Print["Depth[values2D]: ",Depth[values2D]];Print["values2D: ",values2D];*)

(*Print["locHeadersCols: ",locHeadersCols];Print["headerscols: ",headerscols];*)

linemissingitems=Table["...",{Length[First[values2D]]}];
If[Length[optSortCols]==0,
itemsFinal=values2D,
If[MatrixQ[values2D],
itemsFinal=values2D[[Ordering[values2D[[All,Flatten@(FirstPosition[headerscols,#]&/@optSortCols)]]]]],
itemsFinal=values2D[[Ordering[values2D]]]
]
];
If[optReverseSort,itemsFinal=Reverse[itemsFinal]];
(*Print[itemsFinal];*)

locdims=Depth[itemsFinal];
Switch[optSelectItems,All,itemsFinal,"StartEnd",If[optNbRowsheadersrows=Join[Take[headersrows,optNbRows],{"..."},Take[headersrows,-optNbRows]];],"EveryOther",If[optNbRowsheadersrows=Flatten[Riffle[Extract[headersrows,Table[{i},{i,1,Length[values2D],optNbRows}]],{"..."}]];],_List,itemsFinal=Extract[values2D,Flatten[Position[headersrows,#]]&/@optSelectItems];
headersrows=optSelectItems;];
(*Print["Second transpose",locdims];*)
If[locdims>2,
colmissingitems=Table["...",{Length[First[Transpose[itemsFinal]]]}];
Switch[optSelectCols,
All,itemsFinal=itemsFinal,

"StartEnd",If[optNbColsheaderscols=Join[Take[headerscols,optNbCols],{"..."},Take[headerscols,-optNbCols]];],
"EveryOther",If[optNbColsheaderscols=Flatten[Riffle[Extract[headerscols,Table[{i},{i,1,Length[values2D\[Transpose]],optNbCols}]],{"..."}]]],
_List,itemsFinal=Extract[itemsFinal\[Transpose],Flatten[Position[headerscols,#]]&/@optSelectCols]\[Transpose];headerscols=optSelectCols;
];
];
(* The line below is to provide Headers to the Dynamic functions *)
If[OptionValue[ReturnHeaders],Return[{headersrows,headerscols}]];
(*Final display*)

Which[locdims==2,(*Print["Ce point est atteint: ",{Join[{Join[{locTitle},headerscols]},{Join[headersrows,Flatten@itemsFinal]}]}];*)Grid[Join[{Join[{locTitle},headerscols]},{headersrows,itemsFinal}\[Transpose]],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]]]]];


DatasetStructure[ds_Dataset]:=
Which[MatrixQ[Normal@ds], Return[{Normal@ds,{}, {}}],
ListQ[Normal@ds], Return[{ Normal@Values@ds,{}, Normal@Keys@ds[[1]]}],
AssociationQ[Normal@ds],
If[ListQ[Normal@ds[[1]]],Return[{ Normal@Values@ds, Normal@Keys@ds, {}}],

Return[{ Normal@Values@Values@ds, Normal@Keys@ds,Normal@Keys@ds[[1]]}]]
]
Options[DisplayDataset]=Options[DisplayTableWithHeaders];

(* The static function to display dataset *)
DisplayDataset[ds_Dataset,opts:OptionsPattern[]]:=Block[{vals, headCols, headRows},
{vals, headRows, headCols}=DatasetStructure[ds];
If[Length[headRows]==0,headRows = OptionValue[HeadersRows]];
If[Length[headCols]==0,headCols = OptionValue[HeadersCols]];
DisplayTableWithHeaders[vals,HeadersCols->headCols, HeadersRows->headRows,opts]]



(* and a handy function to investigate Dataset on-the-fly *)
Options[DisplayDatasetLive]={HeadersCols->{},HeadersRows->{}, ColumnPickerCols-> True, ColumnPickerRows->False};
DisplayDatasetLive[ds_, opts : OptionsPattern[]]:=Module[{headerscolsFinal,controlCols,controlRows,controlSortBy,selCols,selRows,nbCols,nbRows,selSortCol, optControlPickerCols,optControlPickerRows,headerscols, headersrows,optReverseQ},
{headersrows,headerscols} = DisplayDataset[ds,Join[FilterRules[Flatten[{opts}], Options[DisplayDataset]]],ReturnHeaders->True];
headerscolsFinal =headerscols;
optControlPickerCols=OptionValue[ColumnPickerCols];
optControlPickerRows=OptionValue[ColumnPickerRows];
controlCols =

If[optControlPickerCols,
{{selCols, headerscolsFinal,"Select cols from:"}, headerscolsFinal, ControlType -> TogglerBar},
Sequence @@ {{{selCols, "StartEnd", "View cols:"}, {All, "StartEnd", "EveryOther"}}, {{nbCols, 1, "Number cols for display:"}, 1, Length[ds\[Transpose]], 1}}];
(*Building the control for the rows*)
controlRows = If[OptionValue[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[ds], 1}}];
controlSortBy = {{selSortCol, {},"Sort by columns:"}, headerscolsFinal, ControlType -> TogglerBar};

(* {{selSortCol,"None",
"Sort on column:"}, Prepend[headerscolsFinal,"None"],
ControlType -> PopupMenu};*)
With[{headerscolsManip=headerscolsFinal,headersrowLoc=headersrows, selColsLoc=selCols,selRowsLoc=selRows,nbColsLoc=nbCols,nbRowsLoc=nbRows,controlRowsLoc=controlRows,controlColsLoc=controlCols, controlSortByLoc=controlSortBy,selSortColLoc = selSortCol,
columnPickerRowsLoc=optControlPickerRows,columnPickerColsLoc= optControlPickerCols, ReverseSortQLoc=optReverseQ},
Manipulate[
DisplayDataset[ds, HeadersCols -> headerscolsManip, HeadersRows -> headersrowLoc,
SelectRows -> selRowsLoc, NbRows -> If[columnPickerRowsLoc, 1, nbRowsLoc],
SelectCols -> selColsLoc, NbCols -> If[columnPickerColsLoc, 1, nbColsLoc],
SortCols->selSortColLoc, ReverseSort->ReverseSortQLoc,

FilterRules[Flatten[{opts}], Options[DisplayDataset]]],
Evaluate[controlRowsLoc], Evaluate[controlColsLoc],Row[{Evaluate[Control[controlSortByLoc]]," ",Control[{{ReverseSortQLoc,False,"Reverse order: "},{False,True}}]}]]]];

Again, documention on these functions will consist solely of examples.


First a few test structures:


dsVecCol = Dataset[{<|"a" -> 1|>, <|"a" -> -1|>, <|"a" -> 3|>}]
dsVecRow =
Dataset[<|"\[Alpha]" -> {1}, "\[Beta]" -> {4}, "\[Gamma]" -> {4}|>]
dsMat = Dataset[{{1, 2}, {3, -4}, {4, 5}}]
dsAssList =

Dataset[<|"\[Alpha]" -> {1, -1}, "\[Beta]" -> {4, -3},
"\[Gamma]" -> {4, -3}|>]
dsListAss =
Dataset[{<|"a" -> 1, "b" -> 3|>, <|"a" -> -1, "b" -> -4|>, <|
"a" -> 3, "b" -> 5|>}]
dsAssAss =
Dataset[<|"\[Alpha]" -> <|"a" -> 1, "b" -> 3|>,
"\[Beta]" -> <|"a" -> -1, "b" -> -4|>,
"\[Gamma]" -> <|"a" -> 3, "b" -> 5|>|>]


Displaying standard tabulated data with this API:


DisplayTableWithHeaders[{6, 9}]
DisplayTableWithHeaders[{6, 9}, HeadersCols -> {"a"}]
DisplayTableWithHeaders[{6, 9}, HeadersCols -> {"a"},
SortCols -> {"a"}, ReverseSort -> True]
DisplayTableWithHeaders[{{1, 2}, {3, 4}, {6, 7}},
HeadersCols -> {"a", "b"}]
DisplayTableWithHeaders[{{1, 2}, {3, 4}, {6, 7}},
HeadersCols -> {"a", "b"}]
DisplayTableWithHeaders[{{1, 5}, {-1, 4}, {1, -3}},

HeadersCols -> {"a", "b"}]
DisplayTableWithHeaders[{{1, 5}, {-1, 4}, {1, -3}},
HeadersCols -> {"a", "b"}, SortCols -> {"a", "b"}]
DisplayTableWithHeaders[{{1, 5}, {-1, 4}, {1, -3}},
HeadersCols -> {"a", "b"}, SortCols -> {"a"}, ReverseSort -> True]
DisplayTableWithHeaders[{{1, 5}, {-1, 4}, {1, -3}},
HeadersCols -> {"a", "b"}, SortCols -> {"a", "b"},
ReverseSort -> True]
(* and example of building row headers on the fly*)
DisplayTableWithHeaders[{{1, 5}, {-1, 4}, {1, -3}},

BuilderHeaderRows -> (ToString[#2[[1]]] <> ":" <>
ToString[Total[#1]] &)]
DisplayTableWithHeaders[{{1, 5, 3}, {-1, 4, 6}, {1, -3, 9}},
HeadersCols -> {"a", "b", "c"}, SelectCols -> {"a", "b"}]
DisplayTableWithHeaders[{{1, 5, 3}, {-1, 4, 6}, {1, -3, 9}},
HeadersCols -> {"a", "b", "c"}, SelectCols -> {"a"}]

Static display of Datasets:


DisplayDataset[dsVecCol]
DisplayDataset[dsVecRow]

DisplayDataset[dsMat]
DisplayDataset[dsListAss]
DisplayDataset[dsAssList]
DisplayDataset[dsAssList, HeadersCols -> {"a", "b"}]
DisplayDataset[dsAssAss]
DisplayDataset[dsAssAss, SortCols -> {"b"}, ReverseSort -> True]
DisplayDataset[dsAssAss, SelectCols -> {"b"}, SortCols -> {"b"},
ReverseSort -> True]

Finally, the function to display dataset and manipulate them dynamically:



DisplayDatasetLive[dsVecCol]
DisplayDatasetLive[dsVecRow, HeadersCols -> {"A"}]
DisplayDatasetLive[dsListAss]
DisplayDatasetLive[dsListAss, HeadersCols -> {"A", "B"}]
DisplayDatasetLive[dsAssAss]
DisplayDatasetLive[dsVecRow, ColumnPickerRows -> True]

In the last examples, instead of a column picker control I would like to be able to drag my columns (or rows) with the mouse to re-arrange them. I thought that in context, the issue would look more compelling. And hope it will be useful to other people.




Comments

Popular posts from this blog

plotting - Filling between two spheres in SphericalPlot3D

Manipulate[ SphericalPlot3D[{1, 2 - n}, {θ, 0, Pi}, {ϕ, 0, 1.5 Pi}, Mesh -> None, PlotPoints -> 15, PlotRange -> {-2.2, 2.2}], {n, 0, 1}] I cant' seem to be able to make a filling between two spheres. I've already tried the obvious Filling -> {1 -> {2}} but Mathematica doesn't seem to like that option. Is there any easy way around this or ... Answer There is no built-in filling in SphericalPlot3D . One option is to use ParametricPlot3D to draw the surfaces between the two shells: Manipulate[ Show[SphericalPlot3D[{1, 2 - n}, {θ, 0, Pi}, {ϕ, 0, 1.5 Pi}, PlotPoints -> 15, PlotRange -> {-2.2, 2.2}], ParametricPlot3D[{ r {Sin[t] Cos[1.5 Pi], Sin[t] Sin[1.5 Pi], Cos[t]}, r {Sin[t] Cos[0 Pi], Sin[t] Sin[0 Pi], Cos[t]}}, {r, 1, 2 - n}, {t, 0, Pi}, PlotStyle -> Yellow, Mesh -> {2, 15}]], {n, 0, 1}]

plotting - Plot 4D data with color as 4th dimension

I have a list of 4D data (x position, y position, amplitude, wavelength). I want to plot x, y, and amplitude on a 3D plot and have the color of the points correspond to the wavelength. I have seen many examples using functions to define color but my wavelength cannot be expressed by an analytic function. Is there a simple way to do this? Answer Here a another possible way to visualize 4D data: data = Flatten[Table[{x, y, x^2 + y^2, Sin[x - y]}, {x, -Pi, Pi,Pi/10}, {y,-Pi,Pi, Pi/10}], 1]; You can use the function Point along with VertexColors . Now the points are places using the first three elements and the color is determined by the fourth. In this case I used Hue, but you can use whatever you prefer. Graphics3D[ Point[data[[All, 1 ;; 3]], VertexColors -> Hue /@ data[[All, 4]]], Axes -> True, BoxRatios -> {1, 1, 1/GoldenRatio}]

plotting - Mathematica: 3D plot based on combined 2D graphs

I have several sigmoidal fits to 3 different datasets, with mean fit predictions plus the 95% confidence limits (not symmetrical around the mean) and the actual data. I would now like to show these different 2D plots projected in 3D as in but then using proper perspective. In the link here they give some solutions to combine the plots using isometric perspective, but I would like to use proper 3 point perspective. Any thoughts? Also any way to show the mean points per time point for each series plus or minus the standard error on the mean would be cool too, either using points+vertical bars, or using spheres plus tubes. Below are some test data and the fit function I am using. Note that I am working on a logit(proportion) scale and that the final vertical scale is Log10(percentage). (* some test data *) data = Table[Null, {i, 4}]; data[[1]] = {{1, -5.8}, {2, -5.4}, {3, -0.8}, {4, -0.2}, {5, 4.6}, {1, -6.4}, {2, -5.6}, {3, -0.7}, {4, 0.04}, {5, 1.0}, {1, -6.8}, {2, -4.7}, {3, -1.