Replace options in R Shiny datatable on the fly - r

I would like to change the language of a datatable on the fly
I have the following code
output$prr2 <- renderDataTable({
prr()}, options = list(
autoWidth = TRUE,
columnDefs = list(list(width = '50', targets = c(1, 2) ) ),
language = list(url = if(getLanguage()=='gr') '//cdn.datatables.net/plug-ins/1.10.11/i18n/Greek.json' else
'//cdn.datatables.net/plug-ins/1.10.11/i18n/English.json' ))
getLanguage() returns the value of selected_language, prr() returns a data.frame.
I want to do something like this in order to change options of the table after selecting a different language in a dropdown selected_language
proxy = dataTableProxy('prr2')
observeEvent(input$selected_language,{ replace language option of datatable prr2})
Any idea about this?

I can't test since you don't provide a reproducible example. I would try
output$prr2 <- renderDataTable({
prr()
}, options = exprToFunction(list(
autoWidth = TRUE,
columnDefs = list(list(width = '50', targets = c(1, 2))),
language = list(
url = ifelse(getLanguage()=='gr',
'//cdn.datatables.net/plug-ins/1.10.11/i18n/Greek.json',
'//cdn.datatables.net/plug-ins/1.10.11/i18n/English.json')
)
)))
EDIT
output$prr2 <- renderDataTable({
datatable(
prr(),
options = exprToFunction(list(
autoWidth = TRUE,
columnDefs = list(list(width = '50', targets = c(1, 2))),
language = list(
url = ifelse(getLanguage()=='gr',
'//cdn.datatables.net/plug-ins/1.10.11/i18n/Greek.json',
'//cdn.datatables.net/plug-ins/1.10.11/i18n/English.json')
)
)
)
)
})
EDIT 2
Full app which works:
library(shiny)
library(DT)
ui <- fluidPage(
radioButtons("language", "Language", choices = c("gr", "en")),
DTOutput("prr2")
)
server <- function(input, output, session){
output$prr2 <- renderDT({
datatable(
iris,
options = exprToFunction(list(
autoWidth = TRUE,
columnDefs = list(list(width = '50', targets = c(1, 2))),
language = list(
url = ifelse(input$language=='gr',
'//cdn.datatables.net/plug-ins/1.10.11/i18n/Greek.json',
'//cdn.datatables.net/plug-ins/1.10.11/i18n/English.json')
)
))
)
})
}
shinyApp(ui, server)

Related

How to download only the selected columns in a dataframe using Colvis from DT in Shiny?

I am using the button colvis from the DT package to select which columns I would like to show in the table. Here you have more info about the button colvis.
It works perfectly fine, it hides the columns that I don't want to select and the result is shown to the user.
However, it seems that this info is not updated when I download the file.
If I only select "Petal.Width" and "Species":
Then, I download the file... and I open it. I still have all the columns and not the selected ones.
I have been trying to find a solution, but I haven't found anything.
Does anyone know how to fix it?
Thanks in advance.
Here is my code:
library(shiny)
library(DT)
ui <- fluidPage(
dataTableOutput("table")
)
server <- function(input, output, session) {
output$table <- renderDataTable({
datatable(
iris,
filter = list(position = 'top', clear = FALSE),
selection = "none", #this is to avoid select rows if you click on the rows
rownames = FALSE,
extensions = 'Buttons',
options = list(
scrollX = TRUE,
dom = 'Blrtip',
buttons =
list(I('colvis'),'copy', 'print', list(
extend = 'collection',
buttons = list(
list(extend = 'csv', filename = paste0("iris"), title = NULL),
list(extend = 'excel', filename = paste0("iris"), title = NULL)),
text = 'Download'
)),
lengthMenu = list(c(10, 30, 50, -1),
c('10', '30', '50', 'All'))
),
class = "display"
)
})
}
shinyApp(ui, server)
library(DT)
datatable(
iris,
extensions = "Buttons",
options = list(
dom = "Bfrtip",
buttons = list(
I("colvis"),
list(
extend = "collection",
text = "Download",
buttons = list(
list(
extend = "csv",
exportOptions = list(
columns = ":visible"
)
)
)
)
)
)
)
Thanks to Stéphane Laurent's answer, I managed to find an answer.
I had some problems to have both buttons (csv and excel) and how to organise the lists with the proposed solution, but I found the way to do it.
I will add the answer with the original code just in case someone has problems like me.
library(shiny)
library(DT)
ui <- fluidPage(
dataTableOutput("table")
)
server <- function(input, output, session) {
output$table <- renderDataTable({
datatable(
iris,
filter = list(position = 'top', clear = FALSE),
selection = "none", #this is to avoid select rows if you click on the rows
rownames = FALSE,
extensions = 'Buttons',
options = list(
scrollX = TRUE,
dom = 'Blrtip',
buttons =
list(I('colvis'),'copy', 'print', list(
extend = 'collection',
text = 'Download',
buttons = list(
list(
extend = "csv", filename = paste0("iris"), title=NULL,
exportOptions = list(
columns = ":visible")
),
list(
extend = "excel", filename = paste0("iris"), title=NULL,
exportOptions = list(
columns = ":visible")
)
)
)),
lengthMenu = list(c(10, 30, 50, -1),
c('10', '30', '50', 'All'))
),
class = "display"
)
})
}
shinyApp(ui, server)

R Shiny DT data table column width works on ALL columns, but not on specific column

I have looked at the documentation, and examples, and other answers. But, for the life of me, I can't get the DT::datatable() to widen just one column in my output. When I set the option to include _all columns, it works, but obviously not what I want.
Here is a working example:
library(dplyr)
library(shiny)
library(DT)
library(data.table)
mtcars <- mtcars[1:5, ]
ui <- fluidPage(
fluidRow(
dataTableOutput(('mtcarsDT')),
)
)
server <- function(input, output, session) {
output$mtcarsDT <- DT::renderDataTable({
recFeedbackCol <- lapply(1:nrow(mtcars), function(recnum)
as.character(
radioButtons(
paste0(
'rec', recnum),
'',
choices = c('good' = 'Good', 'bad' = 'Bad', 'neutral' = 'Neutral'),
inline = TRUE
)
)
)
recFeedbackCol <- tibble(feedback = recFeedbackCol)
mtcars <- bind_cols(
mtcars,
recFeedbackCol
)
mtcars %>%
DT::datatable(
escape = FALSE, selection = 'none',
extensions = 'FixedColumns',
options = list(
paging = FALSE, pageLength = 10, ordering = FALSE, scrollX = TRUE,
fixedColumns = list(leftColumns = 2),
preDrawCallback = JS(
'function() { Shiny.unbindAll(this.api().table().node()); }'
),
drawCallback = JS(
'function() { Shiny.bindAll(this.api().table().node()); } '
),
autoWidth = TRUE,
columnDefs = list(list(width = '200px', targets = 'feedback'))
)
)
})
}
shinyApp(ui = ui, server = server)
Changing targets = '_all' works. But, that widens all columns.
> packageVersion('shiny')
[1] ‘1.4.0’
> packageVersion('DT')
[1] ‘0.17’
Anything I am missing?
Update:
Now, I am using ncol(mtcars) and with some options, and the DT does not render at all. I get the columns, and zero rows in display:
library(dplyr)
library(shiny)
library(DT)
library(data.table)
mtcars <- mtcars[1:5, ]
ui <- fluidPage(
fluidRow(
dataTableOutput(('mtcarsDT')),
)
)
server <- function(input, output, session) {
output$mtcarsDT <- DT::renderDataTable({
recFeedbackCol <- lapply(1:nrow(mtcars), function(recnum)
as.character(
radioButtons(
paste0(
'rec', recnum),
'',
choices = c('good' = 'Good', 'bad' = 'Bad', 'neutral' = 'Neutral'),
inline = TRUE
)
)
)
recFeedbackCol <- tibble(feedback = recFeedbackCol)
mtcars <- bind_cols(
mtcars,
recFeedbackCol
)
mtcars %>%
DT::datatable(
extensions = 'FixedColumns',
rownames = FALSE,
escape = FALSE,
class="compact cell-border",
options = list(
pageLength = 15,
lengthChange = FALSE,
scrollX = TRUE,
searching = FALSE,
dom = 't',
ordering = TRUE,
fixedColumns = list(leftColumns = 2),
preDrawCallback = JS(
'function() { Shiny.unbindAll(this.api().table().node()); }'
),
drawCallback = JS(
'function() { Shiny.bindAll(this.api().table().node()); } '
),
autoWidth = TRUE,
columnDefs = list(
list(width = '200px', targets = ncol(mtcars))
)
)
)
})
}
shinyApp(ui = ui, server = server)
For targets you can use a column index number (indexing is zero-based):
targets = 3
Or to target multiple specific columns, use an array:
targets = list(3,4)
There are some additional options, too - see here for reference.
Update
So, using the fact mentioned above about indexing being zero-based, and looking at the reference documentation (see the above link), we can say the following:
The first column in the table has an index of 0.
The second column in the table has an index of 1.
... and so on.
And we can also say:
The last column in the table has an index of -1.
The second-to-last column in the table has an index of -2.
... and so on.

R shiny and DT not rendering with column width set of specific column with some DT options

I have this piece of code. The DT datatable does not render at all. It shows the columns, and nothing else. I posted a related question earlier, but apparently, this issue needed to be posted as a separate question. I am.
Any idea of what I am missing?
library(dplyr)
library(shiny)
library(DT)
library(data.table)
mtcars <- mtcars[1:5, ]
ui <- fluidPage(
fluidRow(
dataTableOutput(('mtcarsDT')),
)
)
server <- function(input, output, session) {
output$mtcarsDT <- DT::renderDataTable({
recFeedbackCol <- lapply(1:nrow(mtcars), function(recnum)
as.character(
radioButtons(
paste0(
'rec', recnum),
'',
choices = c('good' = 'Good', 'bad' = 'Bad', 'neutral' = 'Neutral'),
inline = TRUE
)
)
)
recFeedbackCol <- tibble(feedback = recFeedbackCol)
mtcars <- bind_cols(
mtcars,
recFeedbackCol
)
mtcars %>%
DT::datatable(
extensions = 'FixedColumns',
rownames = FALSE,
escape = FALSE,
class="compact cell-border",
options = list(
pageLength = 15,
lengthChange = FALSE,
scrollX = TRUE,
searching = FALSE,
dom = 't',
ordering = TRUE,
fixedColumns = list(leftColumns = 2),
preDrawCallback = JS(
'function() { Shiny.unbindAll(this.api().table().node()); }'
),
drawCallback = JS(
'function() { Shiny.bindAll(this.api().table().node()); } '
),
autoWidth = TRUE,
columnDefs = list(
list(width = '200px', targets = ncol(mtcars))
)
)
)
})
}
shinyApp(ui = ui, server = server)
The problem seems to be targets parameter of columnDefs. It accepts column index starting from 0. To specify the last column, it needs to be reduced by 1.
columnDefs = list(
list(width = '200px', targets = ncol(mtcars) - 1)
)

Set column width while using scrollX in R

I'm trying to change the width of some columns in a DT::datatable, unfortunately using the columnDefs option only appears to work when there are a small number of columns in the data.
When I add all the columns to my data the column widths no longer follow what I put in the columnDefs options.
Here is an example, as you can see the 1st table the width are all constant, whereas in the second table I have been able to manual set the widths as I desire. Removing the scrollX argument doesn't work either, and given the number of columns my data has I need it in there.
library(MASS)
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
DT::dataTableOutput("table1"),
br(),
br(),
br(),
DT::dataTableOutput("table2")
)
)
server <- function(input, output) {
output$table1 <- DT::renderDataTable({
DT::datatable(
Cars93[,-(20:27)],
rownames = FALSE,
options = list(
pageLength = 5,
autowidth = TRUE,
scrollX = TRUE,
searching = TRUE,
ordering = TRUE,
paging = TRUE,
columnDefs = list(list(width = "200px", targets = c(0:2)),
list(width = "20px", targets = 3),
list(width = "50px", targets = 4))
)
)
})
output$table2 <- DT::renderDataTable({
DT::datatable(
Cars93[,-(6:27)],
rownames = FALSE,
options = list(
pageLength = 5,
autowidth = TRUE,
scrollX = TRUE,
searching = TRUE,
ordering = TRUE,
paging = TRUE,
columnDefs = list(list(width = "200px", targets = c(0:2)),
list(width = "20px", targets = 3),
list(width = "50px", targets = 4))
)
)
})
}
shinyApp(ui, server)
What do I need to change in my code to be able to set the column widths in the 1st table like I have them in the 2nd table while will having all the columns and scrollX?
Thanks
Try:
ui <- fluidPage(
tags$head(
tags$style(
HTML("table {table-layout: fixed;}")
)
),
......
and replace autowidth with autoWidth.

Highlighting table Cells based on headers mentioned in one column data

I am working on below code definition:
If first column value is 'Modified' and second column contains column names which's values has been changed
based on this the data cell needs to be highlighted
I am referring to the code as reference : formatStyle over multiple columns DT R
Below is the definition of table
*
input_data1 <- data.frame(Record_Status = c("Modified","Modified","Modified","Modified","Modified","Modified","Modified","Modified","Modified"),
Field_Changed = c("Brand,ratio","cost","Name","ratio,Name","cost","Brand,cost","ratio,cost","cost","Name"),
Brand = c(3,6,9,12,15,18,21,24,27),
ratio = c (1,2,3,4,5,6,7,8,9),
cost = c(3,6,9,12,15,18,21,24,27),
Name = c("A","B","C","A","B","C","A","B","C"),
stringsAsFactors = FALSE)
hepl_1=tapply(1:ncol( input_data1),function(i) ifelse(( input_data1[[1]]=="Modified" &
str_detect( input_data1[[2]], names( input_data1)[i])),
"red","white"))
help_3=as.matrix( input_data1[1:ncol( input_data1)])
My datatable definition is as below:
output$mod_table <- DT::renderDataTable({
DT::datatable(input_data,selection = 'single',
escape=F, plugins = "ellipsis",
class = 'white-space: nowrap',
filter = list(position = 'top', clear = FALSE) , editable = TRUE,
extensions = c('Buttons','AutoFill','FixedHeader', 'KeyTable','ColReorder'),
rownames = F,
options = list(
keys = TRUE, colReorder = list(realtime = FALSE),
fixedHeader = TRUE, autoFill = list(focus = 'click', horizontal = FALSE) ,
autoWidth=TRUE, pageLength = 7 ,list(target = 'cell'),
lengthMenu = list(c(2, 50, -1), c('2', '50', 'All')), dom = 'lBfrtip',buttons = list(
c('colvis','pdf','excel'),
list(
extend = "collection",
text = 'Show All',
action = DT::JS("function ( e, dt, node, config ) { dt.page.len(-1);
dt.ajax.reload();
}"))))) %>% formatStyle(names(input_data), backgroundColor = styleEqual(help_3, hepl_1))
})
click here for image definition of Hepl1
click here for o/p datatable image - which is not giving me correct highlights
### Libraries
library(shiny)
library(dplyr)
library(DT)
### Data
input_data <- data.frame(Record_Status = c("Modified","Modified","Modified","Modified","Modified","Modified","Modified","Modified","Modified"),
Field_Changed = c("Brand,ratio","cost","Name","ratio,Name","cost","Brand,cost","ratio,cost","cost","Name"),
Brand = c(3,6,9,12,15,18,21,24,27),
ratio = c (1,2,3,4,5,6,7,8,9),
cost = c(3,6,9,12,15,18,21,24,27),
Name = c("A","B","C","A","B","C","A","B","C"),
stringsAsFactors = FALSE)
### Module
modFunction <- function(input, output, session, data,reset) {
v <- reactiveValues(data = data)
proxy = dataTableProxy("mod_table")
### Reset Table
observeEvent(reset(), {
v$data <- data # your default data
})
hepl_1=sapply(1:ncol(input_data),function(i) ifelse(input_data[[1]]=="Modified" &
str_detect(input_data[[2]], names(input_data)[i]),
"yellow","white"))
help_3=as.matrix(input_data)
#print(isolate(colnames(v$data)))
output$mod_table <- DT::renderDataTable({
DT::datatable(input_data,selection = 'single',
escape=F, plugins = "ellipsis",
class = 'white-space: nowrap',
filter = list(position = 'top', clear = FALSE) , editable = TRUE,
extensions = c('Buttons','AutoFill','FixedHeader', 'KeyTable','ColReorder'),
rownames = F,
options = list(
keys = TRUE, colReorder = list(realtime = FALSE),
fixedHeader = TRUE, autoFill = list(focus = 'click', horizontal = FALSE) ,
autoWidth=TRUE, pageLength = 7 ,list(target = 'cell'),
lengthMenu = list(c(2, 50, -1), c('2', '50', 'All')), dom = 'lBfrtip',buttons = list(
c('colvis','pdf','excel'),
list(
extend = "collection",
text = 'Show All',
action = DT::JS("function ( e, dt, node, config ) { dt.page.len(-1);
dt.ajax.reload();
}"))))) %>% formatStyle(names(input_data), backgroundColor = styleEqual(help_3, hepl_1))
})
}
modFunctionUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns("mod_table"))
}
### Shiny App
shinyApp(
ui = basicPage(
mainPanel(
actionButton("reset", "Reset"),
tags$hr(),
modFunctionUI("editable")
)
),
server = function(input, output) {
demodata<-input_data
callModule(modFunction,"editable", demodata,
reset = reactive(input$reset))
}
)

Resources