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

Question

我使用 dataTableproxy 编写了我的代码。我的代码的目标是在单击编辑按钮时打开一个弹出窗口。我可以修改弹出窗口中的行。 代码做得很好，即当我编辑一行时，我可以修改它。 现在我想将值保存在我编辑的表中。我尝试使用 coerceValue 但它不起作用。我想我不明白如何将代理中的值返回到我编辑的表中。 你有什么想法或建议吗？ 提前致谢

# 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

感谢您的链接。我像这样添加了observeEvent：

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)
                         
                        })

它不起作用。我不知道我该怎么做！

Answer 2

这是迄今为止的进展。我创建了row_id 列以将更改合并回初始数据框，并且它没有显示在对话框中。我使用了新的modalActionButton - 感谢@TimTeaFan，因为您的保存按钮没有保存或关闭对话框。

抱歉，我无法完成。我必须完成一些我自己的工作。

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)