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

Question

我试图想出一种方法来防止选择输入在其依赖的数据发生更改时重置。理想情况下，随着更多数据的到达，选择会悄悄地扩展，不会造成视觉中断或输入值重置。我试过使用updateSelectInput，但没有成功。我已经创建了一个合理地近似我的问题的示例，在我的 cmets 和想法中留下了我试图提出解决方案的地方，并希望其他人有更好的想法可以分享。与往常一样，提前感谢您。 -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)

}