Предотвратить выбор ввода от сброса с потоковыми обновлениями данных

Question

Я пытаюсь найти способ предотвратить сброс выбранного входа, когда данные зависят от изменений. В идеале, когда поступает больше данных, выбор расширяется бесшумно, без визуального нарушения или сброса входного значения. Я пытался использовать updateSelectInput, но безуспешно. Я создал пример, который приблизительно соответствует моей проблеме, оставил в моих комментариях и идеях, чтобы показать, где я пытался найти решение, и я надеюсь, что у кого-то еще есть лучшая идея, которой он может поделиться. Как всегда, заранее спасибо.

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

Ниже приведен пример, который работает. Я создаю selectizeInput в части ui и обновляю его при изменении фрейма данных full_dat, используя observeEvent. Мне пришлось сохранить и сбросить выбор в этом шаге обновления, чтобы предотвратить его установку на 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)

}