数据框不会使用 Shiny R 中的observeEvent 进行更新

Question

我是一个新手程序员，如果我不清楚或遗漏相关信息，请原谅。我编写了一个闪亮的应用程序，它从另一组代码导入数据帧。我想使用应用程序中的用户输入更新该数据框。我已经使用下面的代码将数据帧作为反应变量上传：

数据

current.shiny <- data.frame("Task" = as.character(c("Task 1", "Task 2", "Task 3")), "Completed" = as.character(c("Yes", "NO", "Yes")),"Date.Completed" = as.Date(c("2020-10-19","2020-10-20", "2020-10-21")))

用户界面

ui<- fluidPage(
  
  # Application title
  titlePanel("Week of 11.02.2020"),
  
  # Sidebar with reactive inputs
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "task.choice", label = "Task",
                  choices =  c(as.list(current.shiny$Task))),
      selectInput(inputId = "completed", label = "Completed?",
                  choices = c("Yes" = "Yes", "No" = "No")),
      dateInput(inputId = "date.completed", label ="Date Completed"),
      actionButton("update","Update Sheet")
      
    ),
    
    # a table of reactive outputs
    mainPanel(
      mainPanel(
        
        #DT::dataTableOutput("dt_table", width = 500)
        
      )
    )
  ),
  # column(12,
  #        DT::dataTableOutput("data", width = "100%")),
  column(12,
         DT::dataTableOutput("xchange", width = "100%"))
)

服务器1

server <- function(input, output) {
# # Re-read data for any changes, write to csv new changes, ignore startup
 observeEvent(input$update,{
   test.data<-current.shiny
   test.data$Completed[test.data$Task == input$task.choice]<-as.character(input$completed)
   ignoreInit=T
 })

 # #Reactive variable xchange that updates the values of data
 xchange<-reactive({
   test.data<-current.shiny
   test.data$Completed[test.data$Task == input$task.choice]<-as.character(input$completed)
   test.data$Date.Completed[test.data$Task == input$task.choice]<-as.Date(input$date.completed)
   test.data
 })

 #Display the most recent file, with the most recent changes
 output$xchange <- renderDataTable({
   datatable(xchange(), options = list(dom = "t"))
 })
}
shinyApp(ui,server)

这在一定程度上是有效的。然而，它反应过度，因为我需要它只在按下按钮后更新表。上面代码中的observeEvent函数似乎没有做任何事情（它主要是从另一个堆栈溢出线程复制/粘贴的）。我尝试在下面进行设置，但无法让它运行。

服务器2

server <- function(input, output, session) {
  rxframe <- reactiveVal(
    as.data.frame(current.shiny)
  )
  observeEvent(input$update, {
    rxframe$Completed[rxframe$Task == input$task.choice]<-as.character(input$completed)
  })
  output$xchange <- shiny::renderTable( rxframe() )
}

shinyApp(ui, server)

任何人都可以看到我错误地调用observeEvent导致它无法正常运行的某种方式吗？任何见解将不胜感激，我已经坚持这一点有一段时间了。

Answer 1

您的代码直接对每个更改做出反应，因为您正在使用reactive.

如果您想延迟反应，可以observeEvent与reactiveValues或一起使用eventReactive。

reactiveVal这是使用和 的示例observeEvent：

library(shiny)
library(DT)

current.shiny <- data.frame(
    "Task" = as.character(c("Task 1", "Task 2", "Task 3")),
    "Completed" = as.character(c("Yes", "NO", "Yes")),
    "Date.Completed" = as.Date(c("2020-10-19", "2020-10-20", "2020-10-21"))
  )

ui <- fluidPage(
  # Application title
  titlePanel("Week of 11.02.2020"),
  
  # Sidebar with reactive inputs
  sidebarLayout(
    sidebarPanel(
      selectInput(
        inputId = "task.choice",
        label = "Task",
        choices =  c(as.list(current.shiny$Task))
      ),
      selectInput(
        inputId = "completed",
        label = "Completed?",
        choices = c("Yes" = "Yes", "No" = "No")
      ),
      dateInput(inputId = "date.completed", label = "Date Completed"),
      actionButton("update", "Update Sheet")
    ),
    mainPanel(column(
      12,
      DT::dataTableOutput("xchangeOut", width = "100%")
    ))
  ))

server <- function(input, output) {
  xchange <- reactiveVal(current.shiny)
  observeEvent(input$update, {
    test.data <- xchange()
    test.data$Completed[test.data$Task == input$task.choice] <-input$completed
    test.data$Date.Completed[test.data$Task == input$task.choice] <- input$date.completed
    xchange(test.data)
    # write.csv
  })
  
  #Display the most recent file, with the most recent changes
  output$xchangeOut <- renderDataTable({
    datatable(xchange(), options = list(dom = "t"))
  })
}

shinyApp(ui, server)