解决 renderDatatable 中 as.datatable 中的警告

Question

我有一个闪亮的应用程序，我想解决下面的警告。我收到的当前警告是 Warning in processWidget(instance) : renderDataTable ignores ... arguments when expr yields a datatable object; see ?renderDataTable。我知道这是由于 renderDataTable() 调用中的 as.datatable() 调用，如此处所述：

我想知道的是如何更改下面的应用程序以不再显示警告但仍保留单元格上的格式？如何最好地重新安排它并不完全清楚。

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)

^{由 reprex package (v2.0.0)}

于 2021-10-26 创建

Answer 1

正如警告中提到的 renderDataTable ignores ... arguments when expr yields a datatable object - 因此您需要将 ... 对象直接传递给 datatable 函数，或者在这种情况下传递给 as.datatable 函数：

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)

这里只有 server 不是 renderDataTable 的 ... 参数。

解决 renderDatatable 中 as.datatable 中的警告

Resolving warning in as.datatable in a renderDatatable

r

shiny

dt

formattable