R shiny selectizeInput 不適用於 updateSelectizeInput

Question

我在下面分享了代碼。 我有多個選項卡，其中一個選項卡有一個包含 50,000 個唯一值列表的 selectizeInput。 因此，正如這里所建議的https://shiny.rstudio.com/articles/selectize.html我在服務器端使用它。 由於某些原因，包含 selectizeInput 元素的頁面 Dashboard 2 沒有反應。 無論我在那里輸入什么，該字段都是空的。 鑒於我非常大的 shiny 應用程序，我的代碼是使用不同的 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

1. 缺少tabItems調用。
2. 要顯示超過 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直到你 go 到那個選項卡，然后你才應該更新。 在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))
                                )) 
                       )
              )
  )
})