为什么在使用observeEvent时，R中的反应性数据帧没有正确更新

Question

在下面的代码中，我使用observeEvent(input$delSeries3, {...})和renderUI(selectInput(...))允许用户从反应数据帧emptyTbl()中删除所选列。当运行observeEvent()并使用test <<- tmp将数据帧值(在删除列之后(发送到全局环境中时，出于测试目的，它运行良好。我在R studio控制台中查看了test对象的删除后值，它们看起来很好。然而，当我注释掉test <<- tmp并将其替换为emptyTbl(tmp)(目前在下面的代码中注释掉(，试图将这些tmp值发送回反应空间并重新呈现表以反映列删除时，代码不再按预期工作：它错误地自动删除了第一列，否则会产生奇怪的结果。我试着在不同的地方用isolate()包装，但没有效果。

该代码应该允许用户使用操作按钮"添加列；addSeries"；(这有效(，允许用户使用rhandontable包手动编辑单元格并保留这些编辑(这有效，使用hot_to_r(input$hottable)(，并允许用户使用操作按钮"删除所选列；delSeries"；(不太管用(。

我在删除列时做错了什么？在我对反应性和观察者的理解中缺少了一些东西。

代码：

library(dplyr)
library(rhandsontable)
library(shiny)
library(shinyjs)
mydata <- data.frame('Series 1' = c(1,24,0,1), check.names = FALSE)
rownames(mydata) <- c('Term A','Term B','Term C','Term D') 
ui <- fluidPage(br(),
useShinyjs(), 
rHandsontableOutput('hottable'),br(),
fluidRow(
column(1,actionButton("addSeries", "Add",width = '70px')),
column(1,actionButton("delSeries","Delete",width = '70px')),
column(3,hidden(uiOutput("delSeries2"))) 
)
)
server <- function(input, output) {

emptyTbl <- reactiveVal(mydata)

observeEvent(input$hottable, {emptyTbl(hot_to_r(input$hottable))})

output$hottable <- renderRHandsontable({
rhandsontable(emptyTbl(),rowHeaderWidth = 100, useTypes = TRUE)
})

observeEvent(input$addSeries, {
newCol <- data.frame(c(1,24,0,1))
names(newCol) <- paste("Series", ncol(hot_to_r(input$hottable)) + 1)
emptyTbl(cbind(emptyTbl(), newCol))
})

observeEvent(input$delSeries3, {
tmp <- emptyTbl()                                       # values of reactive DF emptyTbl sent to tmp
delCol <- input$delSeries3                              # specify column to delete from selectInput() choice
tmp <- tmp[ , !(names(tmp) %in% delCol), drop = FALSE]  # delete selected column
newNames <- sprintf("Series %d",seq(1:ncol(tmp)))       # generate new column header sequence
names(tmp) <- newNames                                  # assign new column headers to DF
test <<- tmp                                            # send tmp DF to global environment for testing only
# emptyTbl(tmp)                                           # sends values of tmpDF back to reactive DF emptyTbl
})
observeEvent(input$delSeries, show("delSeries2"))
observeEvent(input$addSeries, hide("delSeries2")) 

output$delSeries2 <- renderUI(selectInput("delSeries3", label = NULL,
choices = colnames(hot_to_r(input$hottable)), 
selected = "")
)
}
shinyApp(ui,server)

Answer 1

问题是，默认情况下，如果未指定selectInput的selected值，则默认为选项列表中的第一个元素。因此，当创建"delSeries3"时，所选参数是触发observeEvent并删除该列的第一列或序列。一个简单的解决方案是设置multiple=TRUE，在这种情况下selected默认为无值。第二种选择是"；放慢应用程序的速度"；通过例如添加用户在选择他想要删除的列之后必须点击的另一个CCD_ 18。

library(dplyr)
library(rhandsontable)
library(shiny)
library(shinyjs)
mydata <- data.frame("Series 1" = c(1, 24, 0, 1), check.names = FALSE)
rownames(mydata) <- c("Term A", "Term B", "Term C", "Term D")
ui <- fluidPage(
br(),
useShinyjs(),
rHandsontableOutput("hottable"), br(),
fluidRow(
column(1, actionButton("addSeries", "Add", width = "70px")),
column(1, actionButton("delSeries", "Delete", width = "70px")),
column(3, hidden(uiOutput("delSeries2")))
)
)
server <- function(input, output) {
emptyTbl <- reactiveVal(mydata)
observeEvent(input$hottable, {
emptyTbl(hot_to_r(input$hottable))
})
output$hottable <- renderRHandsontable({
rhandsontable(emptyTbl(), rowHeaderWidth = 100, useTypes = TRUE)
})
observeEvent(input$addSeries, {
newCol <- data.frame(c(1, 24, 0, 1))
names(newCol) <- paste("Series", ncol(hot_to_r(input$hottable)) + 1)
emptyTbl(cbind(emptyTbl(), newCol))
})
observeEvent(input$delSeries3, {
tmp <- emptyTbl() # values of reactive DF emptyTbl sent to tmp
delCol <- input$delSeries3 # specify column to delete from selectInput() choice
tmp <- tmp[, !(names(tmp) %in% delCol), drop = FALSE] # delete selected column
newNames <- sprintf("Series %d", seq(1:ncol(tmp))) # generate new column header sequence
names(tmp) <- newNames # assign new column headers to DF
# test <<- tmp                                            # send tmp DF to global environment for testing only
emptyTbl(tmp) # sends values of tmpDF back to reactive DF emptyTbl
})
observeEvent(input$delSeries, show("delSeries2"))
observeEvent(input$addSeries, hide("delSeries2"))
output$delSeries2 <- renderUI(selectInput("delSeries3",
label = NULL,
choices = colnames(hot_to_r(input$hottable)),
selected = NULL,
multiple = TRUE
))
}
shinyApp(ui, server)