I have this shiny app below which I want to resolve the warning. The current warning I am getting is Warning in processWidget(instance) : renderDataTable ignores ... arguments when expr yields a datatable object; see ?renderDataTable. I know it is due to the as.datatable() call within the renderDataTable() call as mentioned here: R shiny widgetFunc() warning messages with eventReactive(warning 1) and renderDataTable (warning 2)
What I do want to know is how can I change the app below not to have the warning anymore but still to retain the formatting on my cells? It is not entirely evident how best to re-arrange it.
library(shiny)
library(shinydashboard)
library(DT)
library(formattable)
custom_color_picker <- function(x){
sapply(x,function(x){
if(x > 0){
formattable::csscolor("#B7D1DA", format = "hex")
} else {
formattable::csscolor("#D38591", format = "hex")
}
}
)
}
paddedcolor_bar <- function(color = "lightgray", fun = "proportion", fun2 = "custom_color_picker", ...) {
fun <- match.fun(fun)
fun2 <- match.fun(fun2)
formatter("span",
style = function(x) style(
display = "inline-block",
direction = "rtl",
"unicode-bidi" = "plaintext",
"border-radius" = "4px",
"padding-right" = "2px",
"background-color" = fun2(as.numeric(x), ...),
width = sprintf("%010.4f%%", 100 * percent(fun(as.numeric(x), ...)))
))
}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
DT::dataTableOutput("tabOut")
)
)
server <- function(input, output) {
output$tabOut <- DT::renderDataTable({
tab <- data.frame(A = -5:20, B = runif(26,0,10), C = letters)
tab[, 1] <- as.numeric(tab[, 1]) # to be sure it's numerical
as.datatable(
formattable(tab,
list("A" = paddedcolor_bar("lightblue"),
"B" = formatter("span", x ~ sprintf("%10.2f", x, rank(-x)))))
)
}, server = FALSE, plugins = 'natural', options = list(
columnDefs = list(list(type = "natural", targets = "_all")))
)
}
shinyApp(ui, server)
Created on 2021-10-26 by the reprex package (v2.0.0)
As the warning mentions renderDataTable ignores ... arguments when expr yields a datatable object - accordingly you need to pass the ... objects directly to the datatable function or in this case to the as.datatable function:
library(shiny)
library(shinydashboard)
library(DT)
library(formattable)
custom_color_picker <- function(x) {
sapply(x, function(x) {
if (x > 0) {
formattable::csscolor("#B7D1DA", format = "hex")
} else {
formattable::csscolor("#D38591", format = "hex")
}
})
}
paddedcolor_bar <-
function(color = "lightgray",
fun = "proportion",
fun2 = "custom_color_picker",
...) {
fun <- match.fun(fun)
fun2 <- match.fun(fun2)
formatter(
"span",
style = function(x)
style(
display = "inline-block",
direction = "rtl",
"unicode-bidi" = "plaintext",
"border-radius" = "4px",
"padding-right" = "2px",
"background-color" = fun2(as.numeric(x), ...),
width = sprintf("%010.4f%%", 100 * percent(fun(
as.numeric(x), ...
)))
)
)
}
ui <- dashboardPage(dashboardHeader(),
dashboardSidebar(),
dashboardBody(DT::dataTableOutput("tabOut")))
server <- function(input, output) {
output$tabOut <- DT::renderDataTable({
tab <- data.frame(A = -5:20,
B = runif(26, 0, 10),
C = letters)
tab[, 1] <- as.numeric(tab[, 1]) # to be sure it's numerical
as.datatable(
formattable(tab,
list(
"A" = paddedcolor_bar("lightblue"),
"B" = formatter("span", x ~ sprintf("%10.2f", x))
))
# ,
# plugins = 'natural',
# options = list(columnDefs = list(
# list(type = "natural", targets = "_all")
# ))
)
}, server = FALSE)
}
shinyApp(ui, server)
Here only server is not a ... argument to renderDataTable.