格式化表中的动态条件

Question

我正在使用 formattable 在闪亮应用程序的表格中实现一些条件颜色格式。例如，假设我想将值低于 2 的单元格着色为绿色，高于 5 的单元格为红色，介于 2 和 5 之间的单元格为橙色。我会这样写我的格式化函数：

formatter(
  "span", 
  style = x ~ style(
  color = 'white',
  'background-color' =  
    ifelse(x > 5, "red",
      ifelse(x > 2 & x <= 5, "orange",
        "green"))))

但是，我真正想要做的是让用户能够更改这些颜色阈值，即 2 和 5。

假设 user_low 和 user_high 是由用户定义的：

col_format <- 
  formatter(
      "span", 
      style = x ~ style(
      color = 'white',
      'background-color' =  
        ifelse(x > input$user_high, "red",
          ifelse(x > input$user_low & x <= input$user_high, "orange",
            "green"))))

如果我现在尝试将此格式化程序提供给我闪亮的应用程序中的 formattable：

formattable(mtcars, col_format)

我收到以下错误：

'col_format' of mode 'function' was not found

似乎 input$user_low 和 input$user_high 没有被评估，而是在格式化程序中被视为字符串。我试过 eval(), eval(parse())，没有用。

有什么想法吗？

Answer 1

您的代码几乎可以正常运行，但如果您想在表达式中使用 input$user_high 等输入元素，则必须使用 reactive。

这将按顺序发生：

1. 输入元素的值发生变化。 （input$user_low 或 input$user_high）
2. 列格式条件 (col_format) 将更新，因为它的依赖关系发生了变化。
3. dataTableOutput 被重新渲染，因为它依赖于 col_format。

示例代码：

library(shiny)
library(formattable)
library(DT)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      numericInput("user_low", "User low", value = 2, min = 1, max = 5),
      numericInput("user_high", "User high", value = 8, min = 6, max = 10)
    ),

    mainPanel(
      DT::dataTableOutput("table")
    )
  )
)

server <- function(input, output) {
  output$table <- DT::renderDataTable( {
    as.datatable(formattable(mtcars, list(
      cyl = col_format()
    )))
  })

  col_format <- reactive( {
    formatter(
      "span",
      style = x ~ style(
        color = 'white',
        'background-color' =
          ifelse(x > input$user_high, "red",
                 ifelse(x > input$user_low & x <= input$user_high, "orange",
                        "green"))))
  })

}

shinyApp(ui, server)

编辑：要将格式化程序应用于每一列（根据您的评论），您可以使用lapply，如@中的动态生成格式化程序部分所示987654321@。下面的代码将格式应用于整个数据集。

代码：

output$table <- DT::renderDataTable( {
  as.datatable(formattable(mtcars, lapply(1:ncol(mtcars), function(col) {
    area(row = 1:nrow(mtcars), col) ~ col_format() 
  })))
})