CODEWITHSUNDEEP
rdatatabledt
Germano
Germano

Reputation: 125

R: hide cells in DT::datatable based on condition

I am trying to create a datatable with child rows: the user will be able to click on a name and see a list of links related to that name. However, the number of itens to show is different for each name.

> data1 <- data.frame(name = c("John", "Maria", "Afonso"),
                      a = c("abc", "def", "rty"),
                      b=c("ghj","lop",NA),
                      c=c("zxc","cvb",NA),
                      d=c(NA, "mko", NA))
> data1
    name   a    b    c    d
1   John abc  ghj  zxc <NA>
2  Maria def  lop  cvb  mko
3 Afonso rty <NA> <NA> <NA>

I am using varsExplore::datatable2 to hide specific columns:

varsExplore::datatable2(x=data1,  vars=c("a","b","c","d"))

and it produces the below result

example-datatable

Is it possible to modify DT::datatable in order to only render cells that are not "null"? So, for example, if someone clicked on "Afonso", the table would only render "rty", thus hiding "null" values for the other columns (for this row), while still showing those columns if the user clicked "Maria" (that doesn't have any "null").

(Should I try a different approach in order to achieve this behavior?)

Upvotes: 2

Views: 424

Answers (1)

Abdessabour Mtk
Abdessabour Mtk

Reputation: 3888

A look into the inner working of varsExplore::datatable2

Following your request I took a look into the varsExplore::datatable2 source code. And I found out that varsExplore::datatable2 calls varsExplore:::.callback2 (3: means that it's not an exported function) to create the javascript code. this function also calls varsExplore:::.child_row_table2 which returns a javascript function format(row_data) that formats the rowdata into the table you see.

A proposed solution

I simply used my js knowledge to change the output of varsExplore:::.child_row_table2 and I came up with the following :

.child_row_table2 <- function(x, pos = NULL) {

  names_x <- paste0(names(x), ":")
  text <- "
  var format = function(d) {
    text = '<div><table >' +
  "

  for (i in seq_along(pos)) {
    text <- paste(text, glue::glue(
      " (  d[{pos[i]}]!==null ? ( '<tr>' +   
          '<td>' + '{names_x[pos[i]]}' + '</td>' +
          '<td>' + d[{pos[i]}] + '</td>' +
        '</tr>' ) : '' ) + " ))
  }

  paste0(text,
         "'</table></div>'
      return text;};"
  )
}

the only change I did was adding the d[{pos[i]}]!==null ? ....... : '' which will only show the column pos[i] when its value d[pos[i]] is not null.

Looking at the fact that loading the package and adding the function to the global environment won't do the trick, I forked it on github and commited the changes you can now install it by running (the github repo is a read-only cran mirror can't submit pull request)

devtools::install_github("moutikabdessabour/varsExplore")

EDIT

if you don't want to redownload the package I found a solution basically you'll need to override the datatable2 function :

  • first copy the source code into your R file located at path/to/your/Rfile
# the data.table way
data.table::fwrite(list(capture.output(varsExplore::datatable2)), quote=F, sep='\n', file="path/to/your/Rfile", append=T)

# the baseR way
fileConn<-file("path/to/your/Rfile", open='a')
writeLines(capture.output(varsExplore::datatable2), fileConn)
close(fileConn)
  • then you'll have to substitute the last ligne
DT::datatable(
  x, 
  ..., 
  escape = -2, 
  options = opts, 
  callback = DT::JS(.callback2(x = x, pos = c(0, pos))) 
)

with :

DT::datatable(
  x,
  ...,
  escape = -2,
  options = opts,
  callback = DT::JS(gsub("('<tr>.+?(d\\[\\d+\\]).+?</tr>')" , "(\\2==null ? '' : \\1)", varsExplore:::.callback2(x = x, pos = c(0, pos))))
)

what this code is basically doing is adding the js condition using a regular expression.

Result

Upvotes: 1

Related Questions