我有一个迷你的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)
答案 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'))