DT::dataTableproxy 将数据保存在表中

Question

I made my code with dataTableproxy. Goal of my code is to open a pop up when I click the edit button. I can modify the line in the popup. The code is well done, ie when I edit a line I can modify it. Now I would like to save the values in the table I edited. I tried with coerceValue but it doesn't work. I think I didn't understand how to return the values from the proxy to the table I edited. Do you have an idea or some advice? Thanks in advance

# Global.R
  rm(list = ls())
  library(DT)
  library(shiny)
  library(shinydashboard)
  library(dplyr)
  library(lubridate)


  df<-data.frame(
    ECR= c("040/19", "050/20"),
    BEM=as.Date(c("2020/03/01", "2020/02/01")),
    BEE=c("", ""),
    FIN=c(4,-5)
    )

    #ui.R 
     ui<-fluidPage(
                 DT::dataTableOutput(outputId ="data.tab"),
                 actionButton(inputId = "edit",label = "Edit",color="green",class="butt4")
        )
    # Server.R
     server<-function(input, output,session) {

          mod_df <- shiny::reactiveValues(x = df)
          
          output$data.tab <- DT::renderDataTable({
                            DT=df
                            datatable(DT,selection = 'single',
                            escape=F,rownames = FALSE) 
          })
            
          observeEvent(input$edit,
                       {
                         showModal(modalDialog(
                                   infoBox("ECR CARD", uiOutput("card"), 
                                           icon = icon("line-chart")),
                                   DT::dataTableOutput('tab'),
                                   actionButton("save","Save changes")
                         ))
                         }
                       )
          
          output$tab <- DT::renderDT({
                            selected_row=input$data.tab_rows_selected
                            mod_df<-mod_df$x[selected_row,]
                            isolate(mod_df)
                            #print(mod_df)
                            }, escape=FALSE,selection = 'none',editable="all",rownames=FALSE
                            )
          
          val<-eventReactive(input$edit,{
                        selected_row=input$data.tab_rows_selected
                        mod_df<-mod_df$x[selected_row,]
                        mod_df
          })
          
          output$card<- renderText({
                        val.ecr<-val()
                        prettyNum(paste0(val.ecr[1,1]))
          }) 
          
          proxy <- DT::dataTableProxy('tab')
          
          shiny::observe({DT::replaceData(proxy, mod_df$x)})
          
          #######save - IT'S HERE I DON'T HOW I CAN DO?
          observeEvent(input$save,{
            
                          })

     }
    shinyApp(ui, server)

Answer 1

Thanks for the link. I added the observeEvent like that:

observeEvent(input$tab_cell_edit,
                        {
                          newval=input$tab_cell_edit
                          str(newval)
                          i=newval$row
                          j=newval$col
                          v=newval$value
                          mod_df$x[i,j] <<- (DT::coerceValue(v,mod_df$x[i,j]))
                          replaceData(proxy, mod_df$x,resetPaging = FALSE)
                         
                        })

and it doesn't work. I don't know how I can do that!

Answer 2

Here is the progress so far. I have created row_id column to merge the changes back to the initial data frame, and it is not displayed in the dialog box. I have used a new modalActionButton - thanks to @TimTeaFan, as your save button was not saving or closing the dialog box.

Sorry, I could not complete it. I have to complete some of my own work.

df<-data.frame(
  ECR= c("040/19", "050/20"),
  BEM=as.Date(c("2020/03/01", "2020/02/01")),
  BEE=c("", ""),
  FIN=c(4,-5)
)

# this is basically copied from actionButton() and just "`data-dismiss` = "modal"
# from modalButton() is added:
modalActionButton <- function(inputId, label, icon = NULL, width = NULL, ...) {

  value <- restoreInput(id = inputId, default = NULL)
  tags$button(id = inputId, type = "button", style = if (!is.null(width))
    paste0("width: ", validateCssUnit(width), ";"), type = "button",
    class = "btn btn-default action-button", `data-dismiss` = "modal", `data-val` = value,
    list(shiny:::validateIcon(icon), label), ...)

}

#ui.R
ui<-fluidPage(
  DT::dataTableOutput(outputId ="data.tab"),
  actionButton(inputId = "edit",label = "Edit",color="green"), # ,class="butt4"
  verbatimTextOutput("card"),
  DTOutput("tb1")
)
# Server.R
server<-function(input, output,session) {
  nrow <- nrow(df)
  row_id <- c(1:nrow)
  df1 <- data.frame(row_id,df)
  mod_df <- shiny::reactiveValues(x = df1)
  mod_row <- shiny::reactiveValues(dt=NULL)
  values = reactiveValues(modal_closed=F,
                          dat=NULL)

  output$data.tab <- DT::renderDataTable({
    #DT=mod_df$x
    datatable(isolate(mod_df$x),selection = 'single',
              escape=F,rownames = FALSE)
  })

  observeEvent(input$edit,
               {
                 values$modal_closed <- F
                 showModal(modalDialog(
                   infoBox("ECR CARD", uiOutput("card"),
                           icon = icon("line-chart")),
                   DT::dataTableOutput('tab'),
                   easyClose = FALSE,
                   # actionButton("save","Save")
                   # here is the modalActionButton
                   footer = modalActionButton("save", "Close")
                 ))
               }
  )

  val<-eventReactive(input$edit,{
    selected_row=input$data.tab_rows_selected
    data <- mod_df$x[selected_row,]
    data
  })

  observe({ mod_row$dt <- data.frame(req(val()))
            values$dat <- req(val())})

  output$card<- renderText({
    val.ecr<-val()
    prettyNum(paste0(val.ecr[1,1]))
  })

  output$tab <- DT::renderDT({
    req(mod_row$dt)
    # selected_row=input$data.tab_rows_selected
    # mod_df <- mod_df$x[selected_row,]
    isolate(mod_row$dt)
  }, escape=FALSE, selection = 'none',
  editable="all",
  options = list(
    columnDefs = list(
      list(
        visible = FALSE,
        targets = c(0)
      )
    )
  ),
  rownames=FALSE
  )

  proxy <- DT::dataTableProxy('tab')
  proxyy <- DT::dataTableProxy('data.tab')
  #shiny::observe({DT::replaceData(proxy, mod_df$x)})

  #######save - IT'S HERE I DON'T HOW I CAN DO? - still needs some work
  observeEvent(input$tab_cell_edit, {
                 newval=input$tab_cell_edit
                 str(newval)
                 i=newval$row
                 j=newval$col + 1
                 v=newval$value
                 mod_row$dt[i,j] <<- (DT::coerceValue(v,mod_row$dt[i,j]))
                 #replaceData(proxy, mod_row$dt,resetPaging = FALSE)

                 values$dat <- mod_row$dt

               })

  output$tb1 <- renderDT({values$dat}) ##  to check if modified data in the dialog can be displayed

  ## This event is triggered by the actionButton inside the modalDialog
  #  It closes the modal, and by setting values$modal_closed <- T
  observeEvent(input$save, {
    # values$modal_closed <- T  
    # removeModal()
    replaceData(proxy, mod_row$dt,resetPaging = FALSE)
    rowm <- mod_row$dt  ### modified row data
    df1 <- mod_df$x     ### orig data

    ## update orig data with modified row
    tmp <- left_join(df1, rowm, by="row_id") %>% transmute(row_id, ECR = ifelse(is.na(ECR.y), ECR.x, ECR.y),
                                                           BEM = ifelse(is.na(BEM.y), BEM.x, BEM.y),
                                                           BEE = ifelse(is.na(BEE.y), BEE.x, BEE.y),
                                                           FIN = ifelse(is.na(FIN.y), FIN.x, FIN.y) )
    mod_df$x <- tmp
    #replaceData(proxyy, tmp, resetPaging = FALSE)
  })

  # observe({
  #   if (values$modal_closed){
  #     rowm <- mod_row$dt  ### modified row data
  #     df1 <- mod_df$x  ### orig data
  #
  #     tmp <- left_join(df1, rowm, by="row_id") %>% transmute(row_id, ECR = ifelse(is.na(ECR.y), ECR.x, ECR.y),
  #                                                            BEM = ifelse(is.na(BEM.y), BEM.x, BEM.y),
  #                                                            BEE = ifelse(is.na(BEE.y), BEE.x, BEE.y),
  #                                                            FIN = ifelse(is.na(FIN.y), FIN.x, FIN.y) )
  #     mod_df$x <- tmp
  #     replaceData(proxyy, tmp, resetPaging = FALSE)
  #   }
  #
  # })

}
shinyApp(ui, server)

Answer 3

I need to work with dataTableProxy to replace the data after selection of the column which we will display or not the null value, but when i use module the function did not work

library(shiny)
library(DT)
# Data frame df1
# n = 10
# df1 = data.frame(
#   month = month.abb[1:n],
#   YN = rep(c("[Null]", TRUE), times = c(5, 5)),
#   ID = seq_len(n),
#   stringsAsFactors = FALSE
# )
# df1[10,3] <- "[Null]"


modDt <-  function(input, output, session, df1, globalSession){ # Server module
  
  shinyInput = function(FUN, len, id, value, ...) {
    if (length(value) == 1)
      value <- rep(value, len)
    inputs = character(len)
    for (i in seq_len(len)) {
      inputs[i] = as.character(FUN(paste0(id, i), label = NULL, value = value[i]))
    }
    inputs
  }
  # Function for null value
  nullValue <- function(selectedColumn, df) {
    for (columIndex in selectedColumn) {
      df <- subset(df, df[, columIndex] != "[Null]")
      
    }
    
    df
  }
  
  # obtain the values of inputs
  shinyValue = function(id, len) {
    unlist(lapply(seq_len(len), function(i) {
      value = input[[paste0(id, i)]]
      
      if (is.null(value))
        TRUE
      else
        value
    }))
  }
  
  # Data frame with checkbox in the first row  
  df2 = rbind(ID = shinyInput(
    checkboxInput,
    ncol(df1),
    'ID_',
    value = FALSE
  ),
  df1)
  # Reactive function
#
  loopData = reactive({
    df2[1, ] <<-
      shinyInput(
        checkboxInput,
        ncol(df1),
        'ID_',
        value = shinyValue('ID_', ncol(df1)),
        width = '1px'
      )
    
    
    checked <- shinyValue('ID_',  ncol(df1))
    
    changed <- which((checked) != 0)
    
    
    df2 = nullValue(changed, df2)
  })
  
  output$x1 = DT::renderDataTable(
    isolate(loopData()),
    filter = "top",
    escape = FALSE,
    selection = 'none',
    options = list(
      dom = 't',
      paging = FALSE,
      ordering = FALSE,
      preDrawCallback = JS(
        'function() { Shiny.unbindAll(this.api().table().node()); }'
      ),
      drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
    )
  )
  
  proxy = dataTableProxy('x1',session=globalSession)
  
  observe({
    replaceData(proxy, loopData())
    print("yes")
  })
  
}