服务器端选择在 R Shiny 应用程序中不起作用

Question

Here is the main / only docs on server-side selectize 来自 RStudio。按照本文中的示例，我创建了以下示例。下面代码的主要目标是将输入呈现为服务器大小 selectize 输入。请注意，select 选项的获取发生在我们的 app.R 文件 的顶部附近——我们为命名字符向量 namelist_nba 获取数据，我们将其用作 choices 的值。为了可重复性，我已经注释掉了我们的数据获取代码并对前 20 个响应进行了硬编码：

app.R - 你应该可以运行这个。

rm(list = ls())

# Fetch Options for Selectize Input

# source('scripts/pingDB.R')
# sql__namelist_nba <<- paste(readLines("sql/nba/namelist_nba.txt"), collapse=" ")
# namelist_nba <<- getData(sql__namelist_nba)
# namelist_nba <<- namelist_nba[order(namelist_nba$full_name), ]
# namelist_nba <<- setNames(namelist_nba$player_id, namelist_nba$full_name)

# hardcode first 20 results for Whosebug post
namelist_nba <- c(`A.C. Green` = 920L, `A.J. Bramlett` = 1920L, `A.J. Davis` = 203667L, 
  `A.J. Guyton` = 2062L, `Aaron Best` = 1628700L, `Aaron Brooks` = 201166L, 
  `Aaron Craft` = 203905L, `Aaron Epps` = 1629200L, `Aaron Gordon` = 203932L, 
  `Aaron Gray` = 201189L, `Aaron Harrison` = 1626151L, `Aaron Holiday` = 1628988L, 
  `Aaron Jackson` = 1628935L, `Aaron Johnson` = 203638L, `Aaron McKie` = 243L, 
  `Aaron Miles` = 101223L, `Aaron Nesmith` = 1630174L, `Aaron Pettway` = 202925L, 
  `Aaron Thomas` = 1628045L, `Aaron White` = 1626206L)


# create body and sidebar
ui_body <- dashboardBody()

# note use of NS() and modules
ns2 <- NS('nba_player_profile')
ui_sidebar <- dashboardSidebar(
  
  sidebarMenu(
      id = "sidebarMenu",
      menuItem("These Pages", tabName = "team",
        menuSubItem("Player Profile", tabName = "player_profile_nba"),
        conditionalPanel(
          "input.sidebarMenu === 'player_profile_nba'",
          class = NULL,
          selectizeInput(inputId = ns2("player_input"), label = 'Player Search: ', choices = NULL)
        )
      )
  )
)

# server module for "player profile" page
server__player_profile <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      updateSelectizeInput(
        session, 
        inputId = session$ns('player_input'), 
        choices = namelist_nba,
        selected = namelist_nba[1],
        server = TRUE)
    }
  )
}

# shinyserver is where we combine all of our server modules...
server <- shinyServer(function(input, output, session) {
  observeEvent(input$sidebarMenu, {
    print(paste0("sidebarMenu tabName: ", input$sidebarMenu))
  })

  server__player_profile(id = 'nba_player_profile')
})

# ui is where we combine header,sidebar,body
ui <- dashboardPage(
  title="Dashboard Title",
  dashboardHeader(
    title = div("Our Databoard header title"), 
    titleWidth = 300),
  ui_sidebar, ui_body
)

# and return / run the app
app <- shinyApp(ui = ui, server = server)
runApp(app)

当我们运行这个应用程序时，select输入目前根本不起作用。我无法输入玩家姓名，并且单击该框不会显示任何下拉菜单（尽管它确实会在几分之一秒内显示一个很小的空下拉菜单）。我们如何更新我们的代码，以便服务器端 selectize 在这里工作？

请注意，我们的代码示例因使用闪亮的模块而变得有点复杂，即 all documented here。

Answer 1

虽然 updateSelectizeInput() 似乎不起作用，但您可以在 renderUI 中调用 selectizeInput 并使其起作用。试试这个

namelist_nba <- c(`A.C. Green` = 920L, `A.J. Bramlett` = 1920L, `A.J. Davis` = 203667L, 
                  `A.J. Guyton` = 2062L, `Aaron Best` = 1628700L, `Aaron Brooks` = 201166L, 
                  `Aaron Craft` = 203905L, `Aaron Epps` = 1629200L, `Aaron Gordon` = 203932L, 
                  `Aaron Gray` = 201189L, `Aaron Harrison` = 1626151L, `Aaron Holiday` = 1628988L, 
                  `Aaron Jackson` = 1628935L, `Aaron Johnson` = 203638L, `Aaron McKie` = 243L, 
                  `Aaron Miles` = 101223L, `Aaron Nesmith` = 1630174L, `Aaron Pettway` = 202925L, 
                  `Aaron Thomas` = 1628045L, `Aaron White` = 1626206L)



ui_player_profile <- function(id) {
  ns <- NS(id)
  tagList(
    uiOutput(ns("playerinput"))
    #selectInputize(inputId = ns("player_input"), label = 'Player Search: ', choices = NULL)
  )
}

# server module for "player profile" page
server_player_profile <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns
     
        # updateSelectizeInput(
        #   session, 
        #   inputId = ns('player_input'), 
        #   #inputId = session$ns('player_input'),
        #   choices = namelist_nba,
        #   selected = namelist_nba[1] #, server = TRUE
        #   )
     
      output$playerinput <- renderUI({
        selectizeInput(inputId = ns("player_input"), label = 'Player Search: ', choices = namelist_nba, selected = namelist_nba[1])
      })
      
    }
  )
}

# create body and sidebar
ui_body <- dashboardBody()

# note use of NS() and modules

ui_sidebar <- dashboardSidebar(
  
  sidebarMenu(
    id = "sidebarMenu",
    menuItem("These Pages", tabName = "team",
             menuSubItem("Player Profile", tabName = "player_profile_nba"),
             # conditionalPanel(
             #   "input.sidebarMenu === 'player_profile_nba'",
             #   class = NULL,
             ui_player_profile('nba_player_profile')
             
             # )
    )
  )
)

# ui is where we combine header,sidebar,body
ui <- dashboardPage(
  title="Dashboard Title",
  dashboardHeader(
    title = div("Our Databoard header title"), 
    titleWidth = 300),
  ui_sidebar, 
  ui_body
)

# shinyserver is where we combine all of our server modules...
server <- shinyServer(function(input, output, session) {
  observeEvent(input$sidebarMenu, {
    print(paste0("sidebarMenu tabName: ", input$sidebarMenu))
  })
  
  server_player_profile(id = 'nba_player_profile')
})


# and return / run the app
shinyApp(ui = ui, server = server)

服务器端选择在 R Shiny 应用程序中不起作用

Server-side selectize not working in R Shiny app

r

shiny

selectize.js