r-防止选择输入通过流式数据更新重置

Question

我正试图想出一种方法，当选择输入所依赖的数据发生变化时，防止其重置。理想情况下，随着更多数据的到来，选择可以无声地扩展，而不会出现视觉中断或输入值重置。我尝试过使用updateSelectInput，但没有成功。我已经创建了一个合理近似我的问题的例子，并在我的评论和想法中留下，以表明我试图在哪里提出解决方案，我希望其他人有更好的想法可以分享。一如既往，提前感谢您-nate

library(shiny)
if (interactive()) {
ui <- fluidPage(
titlePanel("Is It Possible To Prevent The Select Input From Resetting with New Data Arriving?"),

sidebarLayout(
sidebarPanel(
shiny::uiOutput(outputId = "streaming_select")
),
mainPanel(
tableOutput("table")
)
)
)
server<- function(input, output, session){
session_launched<- reactiveValues(count=1)
fake_global_rv_list<- reactiveValues()
fake_global_rv_list$tmp<- data.frame(glob_0001=runif(10))
session_rv_list<- reactiveValues()
session_rv_list$tmp<- data.frame(sess_0001=runif(10)) 
# Simulating Streaming Data every 7 seconds
shiny::observe({
shiny::invalidateLater(millis = 7000)
shiny::isolate({
shiny::showNotification(ui = "Generating Random Data", type = "default", duration = 3)
tmp<- data.frame(runif(10) )
colnames(tmp)<- paste0("stream_",format(as.numeric(Sys.time())))
session_rv_list$tmp<- cbind(session_rv_list$tmp,  tmp) # Put the random data into the reactive Values list
}) 
})
full_dat<- shiny::reactive({ cbind(fake_global_rv_list$tmp,  session_rv_list$tmp) })

# Table of 'Streaming' Data 
output$table <- renderTable({
full_dat()
})
## Select Input that let's you pick a single column
output$streaming_select<- shiny::renderUI({
if(!is.null(full_dat())){
if(session_launched$count==1){
out<- shiny::selectizeInput(inputId = "streaming_select_input", label="Pick A Column", choices = unique(colnames(full_dat())), selected = NULL, multiple = TRUE)
} 
}
})
## Possible Ideas (?) BELOW
# select_choices<- shiny::eventReactive(full_dat(), {
#   if(!is.null(full_dat())){
#     if(session_launched$count==1){
#       out<- list( choices = unique(colnames(full_dat())), selected = NULL)
#       #shiny::selectizeInput(inputId = "streaming_select_input", label="Pick A Column", choices = unique(colnames(full_dat())), selected = NULL, multiple = TRUE)
#       session_launched$count<- 2
#       return(out)
#     } else if(session_launched$count > 1){
#       old_selections<- input$streaming_select_input
#       out<- list( choices = unique(colnames(full_dat())), selected = old_selections)
#       return(out)
#       #shiny::updateSelectizeInput(session, inputId = "streaming_select_input", choices = unique(colnames(full_dat())), selected = old_selections)
#     }
#   }
# })
# observeEvent(select_choices(), {
#   cat("STR of select_choices is...", "n")
#   cat(str(select_choices()), "n")
# })
# 
# shiny::observeEvent(full_dat(), {
#   if(session_launched$count != 1){
#     old_selections<- input$streaming_select_input
#     shiny::updateSelectizeInput(session, inputId = "streaming_select_input", choices = unique(colnames(full_dat())), selected = old_selections)
#   }
# })

}
shinyApp(ui, server)
}

Answer 1

下面是一个有效的例子。我在ui部分创建了selectizeInput，并使用observeEvent在full_dat数据帧发生变化时对其进行更新。我不得不在这个更新步骤中存储并重置选择，以防止它被设置为NULL。

library(shiny)
if (interactive()) {
ui <- fluidPage(
titlePanel("Is It Possible To Prevent The Select Input From Resetting with New Data Arriving?"),

sidebarLayout(
sidebarPanel(
shiny::selectizeInput(inputId = "streaming_select_input", label="Pick A Column",
choices = NULL,
selected = NULL,
multiple = TRUE)
),
mainPanel(
tableOutput("table")
)
)
)
server<- function(input, output, session){
session_launched<- reactiveValues(count=1)
fake_global_rv_list<- reactiveValues()
fake_global_rv_list$tmp<- data.frame(glob_0001=runif(10))
session_rv_list<- reactiveValues()
session_rv_list$tmp<- data.frame(sess_0001=runif(10)) 
# Simulating Streaming Data every 7 seconds
shiny::observe({
shiny::invalidateLater(millis = 7000)
shiny::isolate({
shiny::showNotification(ui = "Generating Random Data", type = "default", duration = 3)
tmp<- data.frame(runif(10) )
colnames(tmp)<- paste0("stream_",format(as.numeric(Sys.time())))
session_rv_list$tmp<- cbind(session_rv_list$tmp,  tmp) # Put the random data into the reactive Values list
}) 
})
full_dat<- shiny::reactive({ cbind(fake_global_rv_list$tmp,  session_rv_list$tmp) })

# Table of 'Streaming' Data 
output$table <- renderTable({
full_dat()
})
## Select Input that let's you pick a single column
observeEvent(full_dat(), {
selectedCols <- input$streaming_select_input
updateSelectizeInput(session, "streaming_select_input", choices = colnames(full_dat()), selected = selectedCols)
})
}
shinyApp(ui, server)
}