Bugfix: Correctly sort re-ordered columns

NEWS.md

@@ -2,6 +2,8 @@
 
 - Upgraded DataTables version to 1.13.6 (thanks, @stla, #1091).
 
+- Searching and sorting work now when columns are re-ordered by the `ColReorder` extension (thanks, @ashbaldry #1096, @gergness #534, @nmoraesmunter #921, @isthisthat #1069).
+
 - Fixed disabling selection on hyperlink clicks (thanks, @guoci, #1093).
 
 - Fixed an error for R >= 4.3.0 (thanks, @AntoineMichelet, #1095).

R/datatables.R

@@ -275,6 +275,10 @@ datatable = function(
   if (length(colnames) && colnames[1] == ' ')
     options = appendColumnDefs(options, list(orderable = FALSE, targets = 0))
 
+  # enable column names for column reordering by default
+  for (j in seq_len(ncol(data)))
+    options = appendColumnDefs(options, list(name = names(data)[j], targets = j - 1))
+
   style = normalizeStyle(style)
   if (grepl('^bootstrap', style)) class = DT2BSClass(class)
   if (style != 'default') params$style = style

R/shiny.R

@@ -614,10 +614,22 @@ dataTablesFilter = function(data, params) {
     DT_rows_current = list()
   ))
 
+  # map DataTables's column index in the query (`i` here) to the actual column
+  # index in data via its name because the two indices won't match when columns
+  # are reordered via the colReorder extension
+  imap = unlist(lapply(q$columns, function(col) {
+    k = col[['name']]
+    if (!is.character(k) || k == '') return(0L)
+    i = match(k, names(data))
+    if (is.na(i)) stop("The column name '", k, "' is not found in data.")
+    i
+  }))
+  if (all(imap == 0)) imap[] = seq_len(ncol(data))
+
   # which columns are searchable?
   searchable = logical(ncol(data))
-  for (j in seq_len(ncol(data))) {
-    if (q$columns[[j]][['searchable']] == 'true') searchable[j] = TRUE
+  for (j in names(q$columns)) {
+    if (q$columns[[j]][['searchable']] == 'true') searchable[imap[j]] = TRUE
   }
 
   # global searching options (column search shares caseInsensitive)
@@ -634,16 +646,16 @@ dataTablesFilter = function(data, params) {
   # search by columns
   if (length(i)) for (j in names(q$columns)) {
     col = q$columns[[j]]
+    j = imap[j]
     # if the j-th column is not searchable or the search string is "", skip it
-    if (col[['searchable']] != 'true') next
+    if (!searchable[j]) next
     if ((k <- col[['search']][['value']]) == '') next
     k = httpuv::decodeURIComponent(k)
     column_opts = list(
       regex = col[['search']][['regex']] != 'false',
       caseInsensitive = global_opts$caseInsensitive
     )
-    j = as.integer(j)
-    dj = data[i, j + 1]
+    dj = data[i, j]
     i = i[doColumnSearch(dj, k, options = column_opts)]
     if (length(i) == 0) break
   }
@@ -664,7 +676,7 @@ dataTablesFilter = function(data, params) {
     k = ord[['column']]  # which column to sort
     d = ord[['dir']]     # direction asc/desc
     if (q$columns[[k]][['orderable']] != 'true') next
-    col = data[, as.integer(k) + 1]
+    col = data[, imap[k]]
     oList[[length(oList) + 1]] = (if (d == 'asc') identity else `-`)(
       if (is.numeric(col)) col else xtfrm(col)
     )

inst/htmlwidgets/datatables.js

@@ -432,6 +432,8 @@ HTMLWidgets.widget({
         regex = options.search.regex,
         ci = options.search.caseInsensitive !== false;
       }
+      // need to transpose the column index when colReorder is enabled
+      if (table.colReorder) i = table.colReorder.transpose(i);
       return table.column(i).search(value, regex, !regex, ci);
     };
 
@@ -511,7 +513,7 @@ HTMLWidgets.widget({
               if (value.length) $input.trigger('input');
               $input.attr('title', $input.val());
               if (server) {
-                table.column(i).search(value.length ? JSON.stringify(value) : '').draw();
+                searchColumn(i, value.length ? JSON.stringify(value) : '').draw();
                 return;
               }
               // turn off filter if nothing selected
@@ -682,7 +684,7 @@ HTMLWidgets.widget({
             updateSliderText(val[0], val[1]);
             if (e.type === 'slide') return;  // no searching when sliding only
             if (server) {
-              table.column(i).search($td.data('filter') ? ival : '').draw();
+              searchColumn(i, $td.data('filter') ? ival : '').draw();
               return;
             }
             table.draw();

tests/testit/test-sort.R

@@ -0,0 +1,80 @@
+library(testit)
+
+# Factors and strings are searched differently.
+# Older versions of R don't have this set.
+op = options(stringsAsFactors = FALSE)
+
+# Helpers to create client queries that run without errors
+clientQuery = function(data, columns = lapply(names(data), columnQuery)) {
+  columns = rep_len(columns, ncol(data))
+  names(columns) = seq_len(ncol(data)) - 1
+  list(
+    draw = '0',
+    start = '0',
+    length = '10',
+    escape = 'true',
+    search = list(
+      value = '',
+      regex = 'false',
+      caseInsensitive = 'true',
+      smart = 'true'
+    ),
+    columns = columns,
+    order = list()
+  )
+}
+
+columnQuery = function(name = '', orderable = TRUE) {
+  list(
+    name = name,
+    orderable = tolower(orderable),
+    searchable = 'true',
+    search = list(value = '', regex = 'false')
+  )
+}
+
+orderQuery = function(column, dir = 'asc') {
+  list(
+    column = column,
+    dir = dir
+  )
+}
+
+assert('server-side sort handler works', {
+  tbl = data.frame(
+    foo = c('foo', 'bar', 'baz'),
+    bar = c('bar', 'baz', 'foo')
+  )
+
+  query = clientQuery(tbl)
+  out = dataTablesFilter(tbl, query)
+  (out$data %==% unname(tbl))
+
+  query = clientQuery(tbl)
+  query$order[[1]] = orderQuery('0', 'asc')
+  tbl_sort = tbl[order(tbl$foo), ]
+  out = dataTablesFilter(tbl, query)
+  (out$data %==% unname(tbl_sort))
+
+  query = clientQuery(tbl)
+  query$order[[1]] = orderQuery('1', 'desc')
+  tbl_sort = tbl[order(tbl$bar, decreasing = TRUE), ]
+  out = dataTablesFilter(tbl, query)
+  (out$data %==% unname(tbl_sort))
+})
+
+assert('server-side sort handler works with re-ordered columns', {
+  tbl = data.frame(
+    foo = c('foo', 'bar', 'baz'),
+    bar = c('bar', 'baz', 'foo')
+  )
+
+  query = clientQuery(tbl, lapply(c("bar", "foo"), columnQuery))
+  # order is indexed against re-ordered columns
+  query$order[[1]] = orderQuery('0', 'asc')
+  tbl_sort = tbl[order(tbl$bar), ]
+  out = dataTablesFilter(tbl, query)
+  (out$data %==% unname(tbl_sort))
+})
+
+options(op)