使用流数据更新防止 Select 输入重置

Question

我正在尝试想出一种方法来防止 select 输入在它所依赖的数据发生变化时被重置。理想情况下，随着更多数据的到来，选择会悄无声息地扩展，不会造成视觉干扰或输入值重置。我试过使用 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)

}

使用流数据更新防止 Select 输入重置

Prevent Select Input From Resetting With Streaming Data Updates

streaming

r

shiny

selectinput