Shiny应用中output$table的formatRound动态指定列范围问题

问题根因 #

• All是data_subset()响应式表达式内部的局部变量，在renderDataTable的作用域中无法直接访问
• last_col()是dplyr提供的tidy选择语法，DT包的formatRound不支持该语法，仅支持传入数值型列索引
• 隐藏问题：原代码中data_subset最后一步将所有列转为字符型，会导致formatRound对数值列的格式化完全失效

修复方案 #

首先调整data_subset的逻辑，不对数值列做强制字符转换，NA值统一通过DT的配置显示为-；再在renderDataTable中先将响应式数据赋值给临时变量，用ncol()动态获取总列数即可实现动态列范围配置。

关键修改代码 #

1. 调整data_subset逻辑

data_subset <- reactive({
  req(input$daterange1)
  req(input$daterange1[1] <= input$daterange1[2])
  days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
  All<- subset(data(), date2 %in% days)
  All<-All%>% mutate(date2 = format(ymd(date2), "%d/%m/%Y"))%>%
    mutate(TOTAL = rowSums(across(3:last_col()), na.rm = TRUE))
  # 移除全局转字符的逻辑，NA通过DT配置处理
  return(All)
})

2. 调整renderDataTable逻辑

output$table <- renderDataTable({
  # 先将响应式数据赋值给临时变量
  df <- data_subset()
  datatable(df,options = list( columnDefs = list(
        list(className = 'dt-center', targets = "_all"),
        # 配置所有列空值默认显示为'-'
        list(defaultContent = "-", targets = "_all")
      ),
      paging = TRUE,  searching = FALSE,pageLength = 10,dom = 'tip',  scrollx=TRUE),
      rownames = FALSE) %>%
    # 动态指定第3列到最后一列做格式化
    formatRound(3:ncol(df), digits=0)
})

完整可运行代码 #

library(shiny)
library(shinythemes)
library(dplyr)
library(DT)

Test <- structure(list(date2 = structure(c(18808, 18808, 18809, 18810
), class = "Date"), Category = c("FDE", "ABC", "FDE", "ABC"), 
coef = c(4, 1, 6, 1)), row.names = c(NA, 4L), class = "data.frame")

ui <- fluidPage(
  shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                    br(),
                    tabPanel("",
                             sidebarLayout(
                               sidebarPanel(
                                 uiOutput('daterange'),
                                 br()
                               ),
                               mainPanel(
                                 dataTableOutput('table')
                               )
                             ))
  ))

server <- function(input, output,session) {
  data <- reactive(Test)
  data_subset <- reactive({
    req(input$daterange1)
    req(input$daterange1[1] <= input$daterange1[2])
    days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
    All<- subset(data(), date2 %in% days)
    All<-All%>% mutate(date2 = format(ymd(date2), "%d/%m/%Y"))%>%
      mutate(TOTAL = rowSums(across(3:last_col()), na.rm = TRUE))
    return(All)
  })
  
  output$daterange <- renderUI({
    dateRangeInput("daterange1", "Period you want to see:",
                   start = min(data()$date2),
                   end   = max(data()$date2))
  })
  
  output$table <- renderDataTable({
    df <- data_subset()
    datatable(df,options = list( columnDefs = list(
          list(className = 'dt-center', targets = "_all"),
          list(defaultContent = "-", targets = "_all")
        ),
        paging = TRUE,  searching = FALSE,pageLength = 10,dom = 'tip',  scrollx=TRUE),
        rownames = FALSE) %>%
      formatRound(3:ncol(df), digits=0)
  })
}

shinyApp(ui = ui, server = server)

内容的提问来源于stack exchange，提问作者Antonio