通过Shiny App中的操作按钮更新DataTable中的单个单元格

Question

在我的Shiny App中，用户上传数据（数据框FileUpload）。选择一行后，用户可以修改“最小值和最大值”值。然后按下操作按钮（SetNewValues），应将所选行中的参数值替换为计算值（最大值-最小值）。我在控制台中看到了更新的表，但在呈现的表中却看不到。

########## Shiny
library(shiny)

########## Data wrangling
library(dplyr)
library(tidyr)

########## Tables and graphs
library(DT)

##############################
########## Data
##############################
########## Reference values
ReferenceValues <- tibble("Parameter" = LETTERS[1:10],
                          "ExpectedValue" = 5,
                          "MinValue" = 0,
                          "MaxValue" = 10)

########## Simulate file upload
FileUpload <- tibble("Parameter" = LETTERS[1:10],
                     "ObservedValue" = sample(c(1:10), 10))

########## Save file in temporary folder for upload
TempPath <- paste0(tempdir(), "/FileUpload.csv")
write.table(x = FileUpload, file = TempPath)

##############################
########## Server
##############################
server <- function(input, output, session){

  ##############################
  ########## Display uploaded sheet
  ##############################
  Sheet <- reactive({

    validate(
      need(!is.null(input$uploadedfile) == TRUE, 'Please upload file')
    )

    ##############################
    ########## Check if file is uploaded and supress error if not
    ##############################
    req(input$uploadedfile)

    tryCatch(
      {

        ########## Read sheetnames
        Sheet <- read.table(input$uploadedfile$datapath)

      },
      error = function(e) {

        ########## return a safeError if a parsing error occurs
        stop(safeError(e))
      }
    )

    return(Sheet)

  })

  ##############################
  ########## Render Table
  ##############################
  output$ReactiveTable <- renderDT(server = FALSE,{

    DisplayTable <- Sheet()

    ##############################
    ########## Update Values on button
    ##############################
    observeEvent(input$SetNewValues, {

      isolate({

        DisplayTable$ObservedValue[DisplayTable$Parameter == ValuesSelectedParameter()[["SelectedParameter"]]] <- input$MaxParameterValue - input$MinParameterValue

      })

      print(DisplayTable)

    })    

    datatable(DisplayTable, rownames = FALSE)


  })

  ##############################
  ########## SelectedParameter
  ##############################
  ValuesSelectedParameter <- reactive({

    ########## Selected row  
    SelectedRow <- input$ReactiveTable_rows_selected

    ########## Extract values for one selected row
    if (length(SelectedRow) == 1){

      SelectedParameter <- Sheet() %>% slice(SelectedRow) %>% pull(Parameter)

      SelectedParameterValue <- Sheet() %>% slice(SelectedRow) %>% pull(ObservedValue)
      SelectedParameterValueMin <- ReferenceValues %>% slice(SelectedRow) %>% pull(MinValue)
      SelectedParameterValueMax <- ReferenceValues %>% slice(SelectedRow) %>% pull(MaxValue)

    }else{

      SelectedParameter <- ""
      SelectedParameterValue <- NA
      SelectedParameterValueMin <- NA
      SelectedParameterValueMax <- NA

    }

    return(list("SelectedParameter" = SelectedParameter,
                "SelectedParameterValue" = SelectedParameterValue,
                "SelectedParameterValueMin" = SelectedParameterValueMin,
                "SelectedParameterValueMax" = SelectedParameterValueMax))
  })

  ##############################
  ########## Render Ui elements for min and max values 
  ##############################
  output$MinParameterValue <- renderUI({  

    numericInput(inputId = 'MinParameterValue', 
                 label = paste0("Set minimum Value for ", ValuesSelectedParameter()[["SelectedParameter"]]), 
                 value = ValuesSelectedParameter()[["SelectedParameterValueMin"]], 
                 min = 0,  
                 max = 10)

  })

  output$MaxParameterValue <- renderUI({  

    numericInput(inputId = 'MaxParameterValue', 
                 label = paste0("Set maximum Value for ", ValuesSelectedParameter()[["SelectedParameter"]]), 
                 value = ValuesSelectedParameter()[["SelectedParameterValueMax"]], 
                 min = 0,  
                 max = 10)

  })

}

##############################
########## UI
##############################
ui <- fluidPage(
  titlePanel("Test File"),
  mainPanel(fluidRow(
    column(width = 2,
           ########## Upload file
           fileInput("uploadedfile", "Choose Excel File", multiple = FALSE)
    ),
    column(width = 7,
           h3("Reactive Table"),
           dataTableOutput("ReactiveTable")
    ),
    column(width = 3,
           h3("Parameter Input"),
           uiOutput("MinParameterValue"),
           uiOutput("MaxParameterValue"),
           actionButton(inputId = "SetNewValues", "Set New Values")
    )
  )
  )
)

shinyApp(ui = ui, server = server)

如何在表中显示更新的值？

Answer 1

一个大概的解决方案：

定义input$newvalues

然后

#SERVER

# Suppose you're storing your base data frame in input$df and showing 
# your base data frame using output$df, then just redefine the output 
# using an observer.

df<-reactiveValues(NULL)
df[[1]]<-input$df ### Store your base data frame

ObserveEvent(input$newvalues,{
output$df<-renderTable({
# a) Code lines replacing newvalues into your base data frame (use df[[1]] 
# and input$newvalues)
# b) Sentence the new data frame
})
})

# UI

outputTable("output$df")

只需完成a）和b）。