使用 server = T 防止闪亮的 updateSelectizeInput 闪烁

Question

我有一个闪亮的应用程序，在 selectizeInput 中有两种选择，一种是长的，一种是短的。如果用户只想看到短的，他们可以点击一个复选框，选择会相应地改变。此外，如果用户看到长选项，select 一个选项也在短列表中，然后单击复选框，selected 选项应保持 selected。反之亦然。到目前为止，一切都在以下应用程序中运行，该应用程序使用 reactiveValues 和 updateSelectizeInput：

library("shiny")

choicesONE <- c("a","b","c","d","e")

choicesTWO <- c("a","c","e")

ui <- shinyUI(fluidPage(

  sidebarLayout(

    sidebarPanel(

      selectizeInput(inputId="topic",
                     label = ("Topic"),
                     choices=NULL,
                     multiple = T,
                     options=list(maxItems = 1,
                                  placeholder="Please choose...")),

      checkboxInput("sub", "Show only subchoices", value = FALSE, width = NULL)

    ),

    mainPanel(

    )

  )

))

server <- function(input, output, session) {

  #------- Initialize the Memory ----------

  choice <- reactiveValues(selection = NULL) 

  #------ Whenever the inputs are changed, it only modifies the memory----

  observeEvent(input$topic,{

    choice$selection <- input$topic

  })

  #------ Update UI element using the values stored in memory ------

  observe({

    if(input$sub==T) {

      updateSelectizeInput(session,
                           server = T,
                           'topic',
                           choices = choicesTWO,
                           selected = choice$selection)

    } else {

      updateSelectizeInput(session,
                           server = T,
                           'topic',
                           choices = choicesONE,
                           selected = choice$selection)


    }


  })



}

shinyApp(ui = ui, server = server)

在我的真实应用程序中，选项列表包含数千个选项，如果不使用 server = T，应用程序的速度会大大降低。

但是如果我将服务器设置为 true，每次单击复选框后 selectize 字段都会清空然后再次填充，因此 selectize 字段会闪烁。这是非常没有吸引力的，尤其是用户不友好的。

有谁知道如何防止闪烁的同时保持server = T？

Answer 1

只需在您的观察器中使用 isolate

observe({
  if(input$sub==T) {
    isolate(
      updateSelectizeInput(
        session,
        server = T,
        'topic',
        choices = choicesTWO,
        selected = choice$selection
      )
    )
  } else {
    isolate(
      updateSelectizeInput(
        session,
        server = T,
        'topic',
        choices = choicesONE,
        selected = choice$selection
      )
    )
  }
})

Answer 2

我不确定您是否可以在不进入 selectize.js 的情况下获得完全满意的东西。它可能有点 hacky，但如果你只关注用户体验，它就可以完成工作：

choicesONE <- as.character(sample(1:1000000, size = 1000))
choicesTWO <- sample(choicesONE, size = 20)

...

observe({

    if (input$sub) {
        input_choices <- choicesTWO
    } else {
        input_choices <- choicesONE
    }

    input_placeholder <- isolate(input$topic)
    if (!(is.null(input_placeholder) || input_placeholder %in% choicesTWO)) {
        input_placeholder <- "Please choose..."
    }

    isolate(
        updateSelectizeInput(
            session,
            server = T,
            'topic',
            choices = input_choices,
            selected = choice$selection,
            options = list(placeholder=input_placeholder))
    )

})

为了使它更加无缝，您可以使用一点 CSS。

Answer 3

由于默认显示的是较长的选项列表，考虑到较短的列表要短得多，我认为呈现两个列表不会增加太多负担。

这里的技巧是呈现两个列表，但根据复选框的值隐藏其中一个。这样，我们只需要调用一次 renderUI 就可以在服务器端生成 DOM 并且我们已经可以传入选项了。（我从@kluu的回答中借用了这个例子，谢谢！）

这样，我们可以更新 selectizeInput 的选定选项，而不是更新 'choices' 参数。而且 reactiveVal selectedValue 总是有正确的选择。

library("shiny")

ui <- shinyUI(fluidPage(

  sidebarLayout(
    sidebarPanel(
      uiOutput("selectInput"),
      checkboxInput("sub", "Show only subchoices", value = FALSE, width = NULL),
      textOutput("debug")
    ),
    mainPanel()
  )

))

server <- function(input, output, session) {
  choicesONE <- as.character(sample(1:1000000, size = 1000))
  choicesTWO <- sample(choicesONE, size = 20)

  output$selectInput <- renderUI({
    tagList(
      conditionalPanel(
        "!input['sub']",
        selectizeInput(
          "longTopic",
          "Topic",
          choices = choicesONE,
          multiple = FALSE,
          options = list(placeholder = "Please choose...")
        )
      ),

      conditionalPanel(
        "input['sub']",
        selectizeInput(
          "shortTopic",
          "Topic",
          choices = choicesTWO,
          multiple = FALSE,
          options = list(placeholder = "Please choose...")
        )
      )
    )
  })

  selectedValue <- reactiveVal(NULL)

  observe({
    if (input$sub) {
      selectedValue(input$shortTopic)
    } else {
      selectedValue(input$longTopic)
    }
  })

  observeEvent(input$sub, {
    id <- ifelse(input$sub, "shortTopic", "longTopic")
    updateSelectizeInput(session, id,  selected = selectedValue())
  })

  output$debug <- renderText({
    selectedValue()
  })
}

shinyApp(ui = ui, server = server)

使用 server = T 防止闪亮的 updateSelectizeInput 闪烁

Prevent flickering of shiny updateSelectizeInput with server = T

r

shiny

shiny-reactivity