R 闪亮的 selectizeInput 不能与 updateSelectizeInput 一起使用

Question

我有下面分享的代码。我有多个选项卡，其中一个选项卡有一个包含 50,000 个唯一值列表的 selectizeInput。因此，正如这里所建议的 https://shiny.rstudio.com/articles/selectize.html 我在服务器端使用它。由于某些原因，包含 selectizeInput 元素的页面 Dashboard 2 没有反应。无论我在那里输入什么，该字段都是空的。鉴于我非常大的闪亮应用程序，我的代码是使用不同的 R 文件构建的。但是，为了重现该问题，您只需要两个文件。第一个文件名为“app.R”，包含以下代码：

ui <- dashboardPage( 
  title = "Title test", 
  dashboardHeader(title = "Dashboard header"),
  
  dashboardSidebar(  
    includeCSS("www/styles.css"),
    
    sidebarMenu(
      
     menuItem('Retail1', tabName = "tab1", icon = icon("th"),
              menuItem('Dashboard2', tabName = 'retail_dashboard1')
              ),
      
      menuItem('Retail2', tabName = "tab2", icon = icon("th"),
               menuItem('Dashboard2', tabName = 'retail_dashboard2')
               )
      
    )
  ),
  
  
  
  dashboardBody( 
    
    tabItems(
      
      tabItem(tabName = "retail_dashboard2",
              uiOutput("ui_retail_dashboard2")              )
      
    )
  )
)


server <- function(input, output, session) {    
  
  source("Page_retail_dash2.R", local=T) 
  shiny::updateSelectizeInput(session=session, inputId ='element_with_list_of_cities', choices = rownames(mtcars), server = TRUE )
  
  
}
cat("\nLaunching   'shinyApp' ....")
shinyApp(ui, server)

第二个文件名为“Page_retail_dash2.R”，包含以下简单代码：

output$ui_retail_dashboard3 <- renderUI({ 
  
  tabsetPanel(type = "tabs",
              tabPanel("Dashboard 3",

                       
                       h3("Test"),
                       fluidRow(
                         column(2,
                                selectizeInput(inputId = "element_with_list_of_cities_dash3",
                                               label = "Cities",
                                               choices = NULL, 
                                               selected = NULL,
                                               multiple = TRUE # allow for multiple inputs
                                               ,options = list(create = FALSE, maxOptions = 1000)  # if TRUE, allows newly created inputs))
                                )) 
                       )
              )
  )
})

如果您只是复制并粘贴我的代码，您应该能够重现该问题。我还附上了我看到的我的运行我的应用程序。您可能会问为什么第一个选项卡是空的。在我的应用程序中，它不是空的，它有一些表格，但您不需要它来复制此问题。

Answer 1

缺少 tabItems 调用。
要显示超过 1000 个选项，我们需要设置如下内容：selectizeInput(inputId = "myId", label = "myLabel", options = list(maxOptions = 100000L))

同时查看我的相关回答。

library(shiny)
library(shinydashboard)

ui <- dashboardPage( 
  title = "Dashboard", 
  dashboardHeader(title = "Dashboard"),
  dashboardSidebar(   
    # includeCSS("www/styles.css"),
    sidebarMenu(
      menuItem('Retail', tabName = "dash1", icon = icon("th"),
               menuItem('Dashboard2', tabName = 'retail_dashboard2'),
               menuItem('Dashboard3', tabName = 'retail_dashboard3'),
               menuItem('Dashboard4', tabName = 'retail_dashboard4'),
               menuItem('Dashboard5', tabName = 'retail_dashboard5'),
               menuItem('Dashboard6', tabName = 'retail_dashboard6'),
               menuItem('Dashboard7', tabName = 'retail_dashboard7'),
               menuItem('Dashboard8', tabName = 'retail_dashboard8'),
               menuItem('Dashboard9', tabName = 'retail_dashboard9'),
               menuItem('Dashboard10', tabName = 'retail_dashboard10'),
               menuItem('Dashboard11', tabName = 'retail_dashboard11'),
               menuItem('Dashboard12', tabName = 'retail_dashboard12')
      )
    )
  ),
  dashboardBody( 
    tabItems(
      tabItem(tabName = "retail_dashboard3",
              h3('Text'),
              fluidRow(column(12,
                              dataTableOutput("retail_dashboard3_table")))
      ),
      tabItem(tabName = "retail_dashboard4",
              h3('Text'),
              fluidRow(column(12,
                              dataTableOutput("retail_dashboard4_table")))
      ),
      tabItem(tabName = "retail_dashboard5",
              h3('Text'),
              fluidRow(column(12,
                              dataTableOutput("retail_dashboard5_table")))
      ),
      tabItem(tabName = "retail_dashboard6",
              h3('Text'),
              fluidRow(column(12,
                              dataTableOutput("retail_dashboard6_table")))
      ),
      tabItem(tabName = "retail_dashboard7",
              h3('Text'),
              fluidRow(column(12,
                              dataTableOutput("retail_dashboard7_table")))
      ),
      tabItem(tabName = "retail_dashboard8",
              h3('Text'),
              fluidRow(column(12,
                              dataTableOutput("retail_dashboard8_table")))
      ),
      tabItem(tabName = "retail_dashboard9",
              h3('Text'),
              fluidRow(column(12,
                              dataTableOutput("retail_dashboard9_table")))
      ),
      tabItem(tabName = "retail_dashboard10",
              h3('Text'),
              fluidRow(column(12,
                              dataTableOutput("retail_dashboard10_table")))
      ),
      tabItem(tabName = "retail_dashboard11",
              h3('Text'),
              fluidRow(column(12,
                              dataTableOutput("retail_dashboard11_table")))
      ),
      tabItem(tabName = "retail_dashboard12",
              h3('Text'),
              fluidRow(column(12,
                              dataTableOutput("retail_dashboard12_table")))
      ),
      tabItem(tabName = "retail_dashboard2",
              h3("Test"),
              fluidRow(
                column(2,
                       selectizeInput(inputId = "element_with_list_of_cities",
                                      label = "Cities",
                                      choices = NULL, 
                                      selected = NULL,
                                      multiple = TRUE, # allow for multiple inputs
                                      options = list(create = FALSE, maxOptions = 100000L)  # if TRUE, allows newly created inputs))
                       )) 
              )            
      )
    )
  )
)

server <- function(input, output, session) {    
  output$retail_dashboard3_table <- 
    output$retail_dashboard4_table <- 
    output$retail_dashboard5_table <- 
    output$retail_dashboard6_table <- 
    output$retail_dashboard7_table <- 
    output$retail_dashboard8_table <- 
    output$retail_dashboard9_table <- 
    output$retail_dashboard10_table <- 
    output$retail_dashboard11_table <- 
    output$retail_dashboard12_table <- renderDataTable({return(mtcars)})
  updateSelectizeInput(session=session, inputId ='element_with_list_of_cities', choices = 1:60000, server = TRUE)
}

cat("\nLaunching   'shinyApp' ....")
shinyApp(ui, server)

Answer 2

那是因为你更新的太快了。在您转到该选项卡之前，您的变量是 NULL，然后您才应该更新。在 sidebarMenu 中定义 ID，然后在该特定选项卡中定义 updateSelectizeInput。完整代码：

ui <- dashboardPage( 
  title = "Title test", 
  dashboardHeader(title = "Dashboard header"),
  
  dashboardSidebar(  
    #includeCSS("www/styles.css"),
    
    sidebarMenu(id="tabs",
      
      menuItem('Retail1', tabName = "tab1", icon = icon("th"),
               menuItem('Dashboard1', tabName = 'retail_dashboard1')
      ),
      
      menuItem('Retail2', tabName = "tab2", icon = icon("th"),
               menuItem('Dashboard2', tabName = 'retail_dashboard2')
      )
      
    )
  ),
  dashboardBody( 
    
    tabItems(
      
      tabItem(tabName = "retail_dashboard2",
              uiOutput("ui_retail_dashboard2")              )
      
    )
  )
)

server <- function(input, output, session) {    
  
  source("Page_retail_dash2.R", local=T)
  # observe({
  #   print(input$element_with_list_of_cities) 
  #   print(input$tabs)
  # })
  observeEvent(input$tabs,{
    if (input$tabs=="retail_dashboard2")  updateSelectizeInput(session=session, inputId ='element_with_list_of_cities', 
                         choices = rownames(mtcars) , selected=rownames(mtcars)[1], server = TRUE )
  })
  
}
#cat("\nLaunching   'shinyApp' ....")
shinyApp(ui, server)

请注意，您的 ID 应该匹配，我在 Page_retail_dash2.R

中放置了一个虚拟选择

output$ui_retail_dashboard2 <- renderUI({ 
  tabsetPanel(type = "tabs",
              tabPanel("My Dashboard",
                       h3("Test"),
                       fluidRow(
                         column(2,
                                selectizeInput(inputId = "element_with_list_of_cities",
                                               label = "Cities",
                                               choices = c("A","B"), 
                                               selected = "A",
                                               multiple = TRUE # allow for multiple inputs
                                               ,options = list(create = FALSE, maxOptions = 10000L)  # if TRUE, allows newly created inputs))
                                )) 
                       )
              )
  )
})

R 闪亮的 selectizeInput 不能与 updateSelectizeInput 一起使用

R shiny selectizeInput not working with updateSelectizeInput

r

shiny