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.