Passing column name to target option in a shiny datatable - r

I'm stuck in trying to pass the column name (instead the column number) in the target option of columnDefs. The table is dynamic so I definitely need the option to target the column name. Below is a reproducible example. The example is not dynamic, however.
datatable(iris[c(1:20, 51:60, 101:120), ], options = list(columnDefs = list(list(
targets = 5,
render = JS(
"function(data, type, row, meta) {",
"return type === 'display' && data.length > 6 ?",
"'<span title=\"' + data + '\">' + data.substr(0, 6) + '...</span>' : data;",
"}")
))), callback = JS('table.page(3).draw(false);'))
Tried with targets = 'Species' , targets = iris$Species but they didn't work.

if you are interested in setting multiple columns to different widths, consider the following (take care that R is one based, while javascript is one based):
col_a <- which(names(dat) %in% c("column_name1", "column_name2"))
col_b <- which(names(dat) %in% c("column_name3", "column_name4"))
col_c <- which(names(dat) %in% c("column_name5"))
columnDefs = list(list(width = '30px', targets = as.list(col_a - 1)),
list(width = '80px', targets = as.list(col_b - 1)),
list(width = '200px', targets = as.list(col_c - 1)))

Related

Sorting with NA using datatable function in DT package

I am trying to create an html table using the datatable function in the DT package so that when I sort the data in R markdown, missing rows are sorted after the highest number.
For example, in the following table, when I sort by "age" in the markdown file, I would like the row with NA to be listed last so that the order is 14,15,21,NA.
dat <- data.frame("Age" = c(21,15,NA,14),
"Name" = c("John","Dora", "Max", "Sam"),
"Gender" = c("M","F","M",NA))
DT::datatable(dat, filter = c("top"))
I have tried using "na.last = TRUE" and this works when the datatable initially prints, however when clicking the column to sort, NA is still before 14.
Any help would be much appreciated!
With the render columnwise option, you can set the value of the missing values during the sorting:
library(DT)
dat <- data.frame("Age" = c(21,15,NA,14),
"Name" = c("John","Dora", "Max", "Sam"),
"Gender" = c("M","F","M",NA))
render <- JS(
"function(data, type, row) {",
" if(type === 'sort' && data === null) {",
" return 999999;",
" }",
" return data;",
"}"
)
datatable(
dat,
filter = "top",
options = list(
columnDefs = list(
list(targets = 1, render = render)
)
)
)

DT::formatStyle to set background colour of datatable row based on character vector with raw HTML

I'm trying to set the background colour of a datatables row based on a vector with raw HTML (that I do not escape so that it renders a superscript). At this point I can do one or the other: set the background colour correctly by escaping the HTML, or set the superscript correctly by not escaping the HTML, but not both at the same time.
We can use DT::formatStyle with DT::styleEqual to set the background colour of specific rows of a datatable based on a variable in our table; for example, setting the background to gray when V1 == 'Crackers':
library(DT)
df <- data.frame(
V1 = c('Cheese<sup>1</sup>', 'Crackers', 'Taters'),
v2 = c(10, 4, 7))
datatable(df, escape = FALSE) %>%
formatStyle('V1',
target = 'row',
backgroundColor = styleEqual(
levels = 'Crackers',
values = 'gray'))
What I'd like to do is set the background colour of a specific row whose V1 value contains a non-escaped HTML superscript (i.e., Cheese<sup>1</sup>). Note that we set escape = FALSE to correctly render the superscript. Setting the levels argument of styleEqual to that HTML-containing field does not work:
datatable(df, escape = FALSE) %>%
formatStyle('V1',
target = 'row',
backgroundColor = styleEqual(
levels = c('Cheese<sup>1</sup>', 'Crackers'),
values = c('gray', 'gray')))
The issue might be that styleEqual calls htmltools::htmlEscape on the levels argument, i.e.,
htmltools::htmlEscape('Cheese<sup>1</sup>')
[1] "Cheese<sup>1</sup>"
which will obviously not directly match with Cheese<sup>1</sup>.
If we revert to the default escape setting, i.e., datatable(df, escape = TRUE) %>% ..., then we get the correct background colour, but of course, the superscript does not work.
I found a workaround that involved modifying the styleEqual function, adding an extra argument escape that allows us to skip the call to htmlEscape. For example,
styleEqual2 <- function (levels, values, default = NULL, escape = TRUE)
{
n = length(levels)
if (n != length(values))
stop("length(levels) must be equal to length(values)")
if (!is.null(default) && (!is.character(default) || length(default) !=
1))
stop("default must be null or a string")
if (n == 0)
return("''")
if ((is.character(levels) || is.factor(levels)) && escape)
levels = htmltools::htmlEscape(levels)
levels = DT:::jsValues(levels)
values = DT:::jsValues(values)
js = ""
for (i in seq_len(n)) {
js = paste0(js, sprintf("value == %s ? %s : ",
levels[i], values[i]))
}
default = if (is.null(default))
"null"
else DT:::jsValues(default)
JS(paste0(js, default))
}
datatable(df, escape = FALSE) %>%
formatStyle('V1',
target = 'row',
backgroundColor = styleEqual2(
levels = c('Cheese<sup>1</sup>', 'Crackers'),
values = c('gray', 'gray'),
escape = FALSE))
Is there a better way to do this without modifying the source code?
Interesting issue. I've found a trick: use a list instead of a character vector for the levels argument.
datatable(df, escape = FALSE) %>%
formatStyle('V1',
target = 'row',
backgroundColor = styleEqual(
levels = list('Cheese<sup>1</sup>', 'Crackers'),
values = c('gray', 'gray')))
In this way, is.character(levels) and is.factor(levels) are both FALSE.

DT cell hover showing cell based sample sizes from hidden column

I have previously asked how to colour cells based on colours stored in hidden columns (link). I saw that it is also possible to apply hover information for (DT) tables via this and this post.
I want to expand my initial post where I want to add the hover option to display the sample sizes related to the individual cells. These sample sizes are not shown in the table (i.e. hidden) but only display on hover. I am really pushing my knowledge of Java to make this work.
Following on from my initial post the input data frame could look like:
dat <- iris[1:5,1:5]
colours2apply <- sample(x=c(rgb(1, 0, 0 ), rgb(1, 1, 0 ), rgb(0, 1, 1 )), 25, replace = T) %>%
matrix(nrow=5) %>%
data.frame()
set.seed(1234)
SampleSizesToShowInHover <- matrix(round(runif(n = 25, 10, 1000)), nrow=5)
dat <- cbind(dat, colours2apply)
dat <- cbind(dat, SampleSizesToShowInHover)
dat
From the answer in my previous post, this code adds the cell based colouring:
DT <- datatable(dat,
options = list(columnDefs = list(list(visible=FALSE, targets = 6:10))))
for(i in 1:5){
DT <- DT %>%
formatStyle(i, valueColumns = i+5, backgroundColor = JS("value"))
}
DT
How do I add the cell based hovering information in addition to the colouring?
You could simply add a rowcallback to option paramters to get the toopltip from hidden columns. Something like this:
DT <- datatable(dat,
options = list(columnDefs = list(list(visible=FALSE, targets = 6:10)), rowCallback = JS(
"function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {",
"$('td:eq(1)', nRow).attr('title',aData[1+5]);",
"$('td:eq(2)', nRow).attr('title',aData[2+5]);",
"$('td:eq(3)', nRow).attr('title',aData[3+5]);",
"$('td:eq(4)', nRow).attr('title',aData[4+5]);",
"$('td:eq(5)', nRow).attr('title',aData[6+5]);",
"}")))
[EDIT]:
You can do the same thing in loop as follows:
DT <- datatable(dat,
options = list(columnDefs = list(list(visible=FALSE, targets = 6:10)), rowCallback = JS(
"function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {",
'for(i=0; i<5; i++ ){',
"$('td:eq('+i+')', nRow).attr('title',aData[i+5]);",
'}',
"}")))

Show Inf in DT::datatable()

I would like to explicitly show the Inf value inside a datatable instead of a blank
iris[1, 1] <- Inf
DT::datatable(iris[1:2, ])
I don't want to turn the column info character to be able to sort the column (If I do this, sorting will be alphabetically)
Any ideas?
Edit:
I thinks it's possible to adapt this kind of code :
datatable(iris[c(1:20), ], options = list(columnDefs = list(list(
targets = 5,
render = JS(
"function(data, type, row, meta) {",
"return type === 'display' && data.length > 2 ?",
"'<span title=\"' + data + '\">' + data.substr(0, 2) + '...</span>' : data;",
"}")
))))
with #MLavoie solution, it doesn't distinct NA and Inf
df = iris
df[1,1]<-Inf
df[2,1]<-NA
DT::datatable(df)
library(DT)
DT::datatable(df[,], options = list(columnDefs = list(list(
targets = 1,
render = JS(
"function(data, type, row, meta) {",
"return data === null ? 'Inf' : data;",
"}")
))))
The solution is :
options(htmlwidgets.TOJSON_ARGS = list(na = 'string'))
iris[1,1] <- NA
iris[2,1] <- Inf
DT::datatable(head(iris))
thanks to #yihui-xie and #Jeroen at : https://github.com/rstudio/DT/issues/496#issuecomment-363867449
You can do this:
df = iris
df[1,1]<-Inf
datatable(df[1:2,], options = list(columnDefs = list(list(
targets = 1,
render = JS(
"function(data, type, row, meta) {",
"return data === null ? 'Inf' : data;",
"}")
))))
and you could also do it manually:
DT::datatable(df[1:2,], editable = TRUE)

Rshiny Table collapse text overflow

How do we pass CSS arguments text-overflow: ellipsis or other arguments to renderDataTable in R shiny ? I have uneven text description in columns, by Autowidth the rows and columns are expanded based on the contents in respective cell.
I would like to be able to input "ellipsis", for user to be able to expand the cell to read text. Below is my server.r code. I tried to use the eg, explained in http://rstudio.github.io/DT/options.html. However, could not get what I am looking for. Appreciate if any inputs , suggestions are provided.
Thank you
Solved.
The problem was with improper way I passed the arguments. The correct way is below.
output$PM_output <- DT::renderDataTable(
expr = DT::datatable(data.frame.eg),
class = 'cell-border stripe compact hover',
escape = F, selection = 'multiple',
options = list(
autoWidth = T,
LengthMenu = c(5, 30, 50),
columnDefs = list(list(
targets = 6,
render = JS(
"function(data, type, row, meta) {",
"return type === 'display' && data.length > 100 ?", "'<span title=\"' + data + '\">' +
data.substr(0, 100) + '...</span>' : data;", "}"))),
pageLength = 1, server = T)))

Resources