如何在 r shiny 中编辑上传的数据

Question

这是要求。

1）我需要浏览并上传一个 excel 文件（带有包 readxl），该文件用于得出一些我需要在闪亮窗口中显示为不同表格输出的计算

2) 手动编辑上传文件中的一些数据，它应该会自动反映在显示的结果中

3) 我们应该可以下载编辑后的文件了。

到目前为止我已经写了。我在输入数据中有列 ID、曝光和频率。对于每个 ID，我需要使用将显示的相应曝光和频率来计算一个变量。我需要使用 ID 手动编辑频率和曝光（这是唯一的）。我添加了一个“更新”按钮。但改变不是永久的。一旦我再次单击更新按钮，它就会返回

library(shiny)
ui = fluidPage( 

     titlePanel("HEllo world"),
     sidebarLayout(
          sidebarPanel(

               fileInput('file1', 'Choose xlsx file',
                         accept = c(".xlsx")),
               actionButton("go", "update"),
               numericInput('NewVal', 'Enter new Frequency',NULL),
               numericInput('NewExp', 'Enter new Exposure',NULL)),


          mainPanel(
               textInput('ID', 'Enter ID'),
               dataTableOutput('contents')

          )))

server = function(input,output){
     ef <- eventReactive(input$go, {
          infile <- input$file1 
          if(is.null(infile))
               return(NULL)
          file.rename(infile$datapath,paste(infile$datapath, ".xlsx", sep=""))
          data<-read_excel(paste(infile$datapath, ".xlsx", sep=""), 1)

          if(input$ID!="" && input$go>0){
               for( i in 1:nrow(data)){

                    if( input$ID == data$'ID'[i]){

                         if(!is.na(input$NewVal)){
                              data$' Frequency'[i] <- input$NewVal
                         }

                         if(!is.na(input$NewExp)){
                              data$'Exposure'[i] <- input$NewExp
                         }
                    }}}

          data
     }, ignoreNULL =  FALSE)  


     output$contents <- renderDataTable({ef()})}
shinyApp(ui,server)

更新！：根据一个答案，我对我的代码进行了一些更改。新代码似乎运行良好。这是工作代码，供任何可能在同一问题上需要帮助的人使用。

ui = fluidPage( 

 titlePanel("HEllo world"),
  sidebarLayout(
  sidebarPanel(

  fileInput('file1', 'Choose xlsx file',
            accept = c(".xlsx")),
  actionButton("go", "update"),
  numericInput('NewVal', 'Enter new Frequency',NULL),
  numericInput('NewExp', 'Enter new Exposure',NULL)),


mainPanel(
  textInput('ID', 'Enter ID'),
  tableOutput('contents')

)))

  server = function(input,output){
  # Reactive value to save input data frame for use elsewhere
   original <- reactiveValues()

  observeEvent(input$file1, {
  theFile <- input$file1
   if(is.null(theFile)) {
    return(NULL)}
    **file.rename(theFile$datapath,paste(theFile$datapath, ".xlsx", sep=""))**
     original$oldData <- read_excel(paste(theFile$datapath, ".xlsx", sep = ""), 1)    
    })

   observeEvent(input$go, {

   original$newData <- original$oldData
   if(input$ID !="") {
    for( i in 1:nrow(original$oldData)){

     if( input$ID == original$oldData$'ID'[i]){

      if(!is.na(input$NewVal)){
        original$newData$'Frequency'[i] <- input$NewVal
      }

      if(!is.na(input$NewExp)){
        original$newData$'Exposure'[i] <- input$NewExp
      }
     }
    }
    **original$oldData<-original$newData**  }
  })

output$contents <- renderTable({
  if(!is.null(original$newData)) {
  original$newData}
else {
  original$oldData}
  })
  }
  shinyApp(ui = ui, server = server)

Answer 1

一些 cmets 似乎对这里发生的事情走在了正确的轨道上。有几种解决方案可以使用，但我只会分享对我来说最直观的东西。另外，我只会更改服务器功能。

server = function(input,output){
 # Reactive value to save input data frame for use elsewhere
 original <- reactiveValues()

 observeEvent(input$file1, {
   theFile <- input$file1
   if(is.null(theFile)) {return(NULL)}
   original$oldData <- read_excel(paste(theFile$datapath, ".xlsx", sep = ""), 1)    
 })

 observeEvent(input$goButton2, {
   original$newData <- original$oldData
   if(input$ID !="") {
          for( i in 1:nrow(data)){
                if( input$ID == dat$'ID'[i]){

                     if(!is.na(input$NewVal)){
                          original$newData$' Frequency'[i] <- input$NewVal
                     }

                     if(!is.na(input$NewExp)){
                          original$newData$'Exposure'[i] <- input$NewExp
                     }
                }
          }
   }
 })

 output$contents <- renderDataTable({
   if(!is.null(original$newData)) {original$newData}
   else {original$oldData}
 })
}

在单击 go 按钮之前，这不会更改表格输出。我没有完全测试它，因为我没有你的数据，但我相信这至少应该让你走上正确的轨道......我喜欢观察陈述，因为它们会产生副作用并且看起来更开放比 eventReactives 或函数。

这仅有助于解决进行正确更改并继续在输出中显示的初始问题。如果这可行，那么添加下载功能应该相当容易，该功能会在文件更新时保存文件。

更新 1

下面的代码应该做你想做的事。我添加了两种不同的功能来保存新的数据框。只要按下更新按钮，注释掉的代码就会自动保存数据。周围没有 cmets 的代码创建了一个用于下载数据的下载按钮。我还添加了一条根据频率和曝光计算新值的行。在数据集中将此列命名为 Value。希望这可以帮助！

#### Example app for Exchange answer
library(shiny)
library(readxl)

ui = fluidPage( 

  titlePanel("HEllo world"),
  sidebarLayout(
    sidebarPanel(

      fileInput('file1', 'Choose xlsx file',
                accept = c(".xlsx")),
      actionButton("go", "update"),
      numericInput('NewVal', 'Enter new Frequency',NULL),
      numericInput('NewExp', 'Enter new Exposure',NULL),

      # Download button (goes with download handler below)
      # Use if desire is to save at press of button
      downloadButton("save", "Download")
    ),

    mainPanel(
      textInput('ID', 'Enter ID'),
      dataTableOutput('contents')
    )
  )
)

server = function(input,output){
  # Reactive value to save input data frame for use elsewhere
  original <- reactiveValues()

  observeEvent(input$file1, {
    theFile <- input$file1
    if(is.null(theFile)) {
      original$oldData <- NULL
    } else {
      original$oldData <- read_excel(theFile$datapath, 1)      
    }
  })

  observeEvent(input$go, {

    original$newData <- original$oldData
    if(input$ID !="") {
      for(i in 1:nrow(original$oldData)){

        if(input$ID == original$oldData$'ID'[i]){

          if(!is.na(input$NewVal)){
            original$newData$'Frequency'[i] <- input$NewVal
          }

          if(!is.na(input$NewExp)){
            original$newData$'Exposure'[i] <- input$NewExp
          }
          ### Make sure a column in your data set is named Value for this
          # Calculate a new column
          original$newData$'Value'[i] <- (original$newData$'Exposure'[i]*
                                            original$newData$'Frequency'[i])
        }
      }

      original$oldData<-original$newData  
    }

    ### Use this to automatically save table when update is clicked
    # write.csv(original$newData, 
    #           file = #Desired Pathname, 
    #           row.names = FALSE)
  })

  output$contents <- renderDataTable({
     if(!is.null(original$newData)) {
      original$newData}
    else {
      original$oldData
    }
  })

  ### Use this code below if desired saving is through download button
  # Server code for download button
  output$save <- downloadHandler(
    filename = function() {
      paste0("newData - ", Sys.Date(), ".csv")
    },

    content = function(con) {
      if (!is.null(original$newData)) {
        dataSave <- original$newData
      } else {
        dataSave <- original$oldData
      }
      con <- ## Desired save location... could just use `getwd()` to
        # save to working directory
      write.csv(dataSave, con)
    }
  )

}


shinyApp(ui = ui, server = server)