Question

我有一个闪亮的应用程序，它在selectizeInput中有两种选择，一个是长选择，另一个是短选择。如果用户只希望看到简短的内容，则可以单击一个复选框，然后相应地进行选择更改。此外，如果用户看到长选项，请选择一个也在短列表中的选项，然后单击复选框，所选选项应保持选中状态。反之亦然。到目前为止，所有内容都可以在以下使用observeEvent(c(input$key, input$Product), { updateSelectInput( session, "Product_d", "Product Description", choices = Source_Data %>% filter(key %in% input$key, Product_Name %in% input$Product) %>% select(Product_desc), selected = FALSE ) })和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设置为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就能获得完全令人满意的东西。可能有点棘手，但是如果您只关注UX，那么它就能完成工作：

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”参数。而且reactValve 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)

防止服务器= T闪烁闪亮的updateSelectizeInput

3 个答案: