r-通过闪亮应用程序中的动作按钮在数据表中更新单元单元

Question

在我的闪亮应用程序中，用户上传数据(dataframe 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(。