Reactive update cells fomart in DT shiny

Question

What I am trying to do is to have a DT in shiny that highlights the cells that do not meet specific rules (using the validate package) from a file the user can upload, so the user can edit the cells to values that meet the criteria, and if the new value is correct, the highlighted cell should not be longer highlighted.

In the code below, I am able to highlight the cells that does not meet the criteria, but I am not able to update the highlights once the user edit the cells. I know this is something related to the fact I am calling the submitted file when I validate the data, but I do not know how I can access the edited data in DT, so the rules can be run in a reactive way by the user input.

I would prefer to change the highlight each time the user edits the cell, but I do not mind if this can be better implemented using a validation button for example.

Here is a minimum reproducible example of what I have so far. Please note, I use a submit file button to upload the file, but the excel file I am using for this example can be easily created by:

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"

Shiny app:

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

Try this

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)