renderDataTable中单元格的条件格式

时间:2020-03-20 13:43:21

标签: r shiny dt

我有一个迷你的Shiny应用程序,其中显示了一个可由用户编辑的小表。我想知道如何向该表添加以下功能:

如果该行的最后一个单元格(列“ Comment”)包含(除其他外)字符串“ for yellow”,则将整个行的背景更改为黄色,但如果最后一个单元格包含字符串“为绿色”。这两个字符串永远不会一起出现在同一单元格中。

我当前的代码(如下)有一个问题:如果我的“注释”列中还有其他文本-除了目标字符串“黄色”或“绿色”以外-格式也消失了。我希望即使在最后一个单元格的文本中也有其他字符串的情况下,也要保留在那里。

非常感谢您!

library(shiny)
library(shinydashboard)
library(DT)

# ________________________________________________________________________________________
### UI code ####

ui <- dashboardPage(
  dashboardHeader(title = "DataTable"),
  dashboardSidebar(),
  dashboardBody(
    box(title = "Edit and Export",
      DT::dataTableOutput("o_my_table", width = "600px")))
)

# _________________________________________________________________________________
### SERVER code ####

server <- function(input, output) {

  ### Generate an example table ####
  my_data <- data.frame(
    Order = 1:3, Name = c("John", "Mary", "Paul"),
    Date = as.Date(c("2020-03-01", "2020-03-5", "2020-03-06")),
    Amount = c(100, 150, 200), Paystatus = c("Yes", "No", "Yes"),
    Comment = c(NA, "for yellow", "for green"), stringsAsFactors = FALSE)

  ### Define datatable ####

  output$o_my_table <- DT::renderDataTable({

    datatable(my_data,
              extensions = "Buttons",         # for table export
              editable = list(target = "cell", disable = list(columns = 1)),
              options = list(dom = "Bfrtip",
                             autoWidth = FALSE,
                             buttons = list(
                               list(extend = 'excel',
                                    title = 'My Data',
                                    text = 'Export data',
                                    exportOptions = list(modifier = list(page = 'all')))),
                             columnDefs = list(list(width = "180px", targets = 1:3)))
    ) %>%
      formatStyle('Comment', target = 'row',
                  backgroundColor = styleEqual("for yellow", 'yellow')) %>% 
      formatStyle('Comment', target = 'row',
                  backgroundColor = styleEqual("for green", 'green'))

  })

  ### Define proxy datatable (needed for editable event) ####
  proxyTable_my_table <- dataTableProxy("o_my_table")

  ### Observe edit cell of table ####
  observeEvent(input$o_my_table_cell_edit, {

    info <- input$o_my_table_cell_edit
    i <- info$row # get row number
    j <- info$col # get column number
    v <- info$value

    # my_data dataframe is being updated:
    my_data[i, j] <<- v  # global assignment should be ok because my_data is inside our server
    replaceData(proxyTable_my_table, my_data, resetPaging = FALSE)
  })
}

# ________________________________________________________________________________________
### Return a Shiny app object ####
shinyApp(ui = ui, server = server)

1 个答案:

答案 0 :(得分:1)

您可以通过下面的styleContain函数来实现所需的目标:

library(DT)

styleContain <- function(string, color){
  JS(sprintf("value === null || value.match(/\\b%s\\b/) === null ? '' : '%s'", 
             string, color))
}

my_data <- data.frame(
  Order = 1:3, Name = c("John", "Mary", "Paul"),
  Date = as.Date(c("2020-03-01", "2020-03-5", "2020-03-06")),
  Amount = c(100, 150, 200), Paystatus = c("Yes", "No", "Yes"),
  Comment = c(NA, "xxx for yellow", "for green"), stringsAsFactors = FALSE)

datatable(my_data) %>%
  formatStyle('Comment', target = 'row',
              backgroundColor = styleContain("for yellow", 'yellow'))

编辑

如果一个人使用两个formatStyle,则先前的代码将无法正常工作。解决方法:

library(DT)

styleContain <- function(string, color){
  JS(sprintf("value === null || value.match(/\\b%s\\b/) === null ? value : '%s'", 
             string, color))
}

my_data <- data.frame(
  Order = 1:3, Name = c("John", "Mary", "Paul"),
  Date = as.Date(c("2020-03-01", "2020-03-5", "2020-03-06")),
  Amount = c(100, 150, 200), Paystatus = c("Yes", "No", "Yes"),
  Comment = c(NA, "xxx for yellow", "for green"), stringsAsFactors = FALSE)

datatable(my_data) %>%
  formatStyle('Comment', target = 'row',
              backgroundColor = styleContain("for yellow", 'yellow')) %>%
  formatStyle('Comment', target = 'row',
              backgroundColor = styleContain("for green", 'green'))