r-反应性更新细胞在DT中发光

Question

我想做的是让DT闪亮起来，从用户可以上传的文件中突出显示不符合特定规则的单元格(使用验证包(，这样用户就可以将单元格编辑为符合条件的值，如果新值正确，突出显示的单元格就不应该再突出显示了。

在下面的代码中，我可以突出显示不符合条件的单元格，但一旦用户编辑单元格，我就无法更新突出显示。我知道这与我在验证数据时调用提交的文件有关，但我不知道如何访问DT中编辑的数据，因此可以通过用户输入以响应方式运行规则。

我更愿意在用户每次编辑单元格时更改高亮显示，但我不介意是否可以使用验证按钮更好地实现这一点。

这是我迄今为止所拥有的一个最低限度的可复制的例子。请注意，我使用提交文件按钮上传文件，但我在本例中使用的excel文件可以通过以下方式轻松创建：

df_submitted <- data.frame(x=c(1:20),y=c(0:1),z=c("R"))
df_submitted[[2,2]] <- 3
df_submitted[[3,3]] <- "python"

闪亮的应用程序：

library(shiny)
library(readxl)
library(openxlsx)
library(tidyverse)
library(validate)
library(DT)
ui <- (fluidPage(
titlePanel("Test"),
sidebarLayout(sidebarPanel(
fileInput("df_submitted","Upload your file",accept = c(".xlsx"))
),
mainPanel(
DTOutput("df_tested"))
)
))
server <- function(input, output, session) {
df <- reactiveValues(data=NULL)

#Upload file
df_uploaded <- reactive({  
file_submitted <- input$df_submitted
file_ext <- tools::file_ext(file_submitted$name)
file_path <- file_submitted$datapath
if (is.null(file_submitted)){
return(NULL)
}
if (file_ext=="xlsx"){
read_xlsx(file_path,sheet=1)
}
})
observe({
df$data <- df_uploaded()
})

###Validate form
validator_react <- reactive({
req(df$data)
df_validate <- df$data
##rules
rules <- validator(
x>5,
y<2,
z=="R"
)
#Confront rules against df
out <- confront(df_validate,rules)
cells_dt <- data.frame(values(out))
cells_dt <- cells_dt %>%
mutate_all(function(x) ifelse(x==TRUE,0,1))
#Join cells that fail the rules for future highlight in DT
df_validate <- cbind(df_validate,cells_dt)
df_validate
})

output$df_tested=renderDT({
df_dt <- validator_react()
visible_cols <- 1:((ncol(df_dt)/2))
hidden_cols <- ((ncol(df_dt)/2)+1):ncol(df_dt)

df_dt %>%
datatable(
editable=T,
options=list(
dom="Bfrtip",
autoWidth=T,
columnDefs=list(list(targets=hidden_cols,visible=F)))) %>%
formatStyle(visible_cols,hidden_cols,
backgroundColor=styleEqual(c(0,1),c("white","#FFC7CE")),
color=styleEqual(c(0,1),c("black","#9C0006")))
},server=F)

#The below code is not working, I saw some examples using a similar approach but, not sure how to implemented, but I guess the solution goes in this direction
dt_proxy <- dataTableProxy("df_tested")
observeEvent(input$update_cells, {
info <- input$update_cells
df$data <<- editData(df$data,info,dt_proxy)
}) 
#
}#End server
shinyApp(ui = ui, server = server)

Answer 1

试试这个

library(shiny)
library(readxl)
library(openxlsx)
library(tidyverse)
library(validate)
library(DT)
ui <- (fluidPage(
titlePanel("Test"),
sidebarLayout(sidebarPanel(
fileInput("df_submitted","Upload your file",accept = c(".xlsx"))
),
mainPanel(
DTOutput("df_tested"))
)
))
server <- function(input, output, session) {
df <- reactiveValues(data=NULL)
#Upload file
df_uploaded <- reactive({
file_submitted <- input$df_submitted
file_ext <- tools::file_ext(file_submitted$name)
file_path <- file_submitted$datapath
if (is.null(file_submitted)){
return(NULL)
}
if (file_ext=="xlsx"){
read_xlsx(file_path,sheet=1)
}
})
observe({
df$data <- df_uploaded()
})
###Validate form
validator_react <- reactive({
req(df$data)
df_validate <- df$data
##rules
rules <- validator(
x>5,
y<2,
z=="R"
)
#Confront rules against df
out <- confront(df_validate,rules)
cells_dt <- data.frame(values(out))
cells_dt <- cells_dt %>%
mutate_all(function(x) ifelse(x==TRUE,0,1))
#Join cells that fail the rules for future highlight in DT
df_validate <- cbind(df_validate,cells_dt)
df_validate
})
output$df_tested=renderDT({
df_dt <- validator_react()
visible_cols <- 1:((ncol(df_dt)/2))
hidden_cols <- ((ncol(df_dt)/2)+1):ncol(df_dt)
df_dt %>%
datatable(
editable=T,
options=list(
dom="Bfrtip",
autoWidth=T,
columnDefs=list(list(targets=hidden_cols,visible=F)))) %>%
formatStyle(visible_cols,hidden_cols,
backgroundColor=styleEqual(c(0,1),c("white","#FFC7CE")),
color=styleEqual(c(0,1),c("black","#9C0006")))
},server=F)
#The below code is not working, I saw some examples using a similar approach but, not sure how to implemented, but I guess the solution goes in this direction
dt_proxy <- dataTableProxy("df_tested")
observeEvent(input$df_tested_cell_edit, {
info <- input$df_tested_cell_edit
df$data <<- editData(df$data,info,dt_proxy)
})
}#End server
shinyApp(ui = ui, server = server)