r - updateSelectInput 标签不接受 HTML 标签？

Question

我的 Shiny 应用程序中的“selectInput”和“updateSelectInput”组合出现问题(我是 Shiny 的新手，但似乎无法在任何地方找到该问题的答案)。我想用 html 标签格式化标签，如下面的基本示例(例如，在两行之间拆分，更改字体大小)。这适用于“selectInput”，但“updateSelectInput”无法消化相同的标签，它输出“[object Object]”。在我看来，它无法处理 html 标签。有什么解决方法吗？？？谢谢!

ui.R:

# Load libraries needed for app
library(shiny)
library(shinydashboard)

# Define the overall UI with a dashboard page template
shinyUI(
   dashboardPage(
      dashboardHeader(title = "dashboard header"),
      dashboardSidebar( 
         #Create first dropdown box
         selectInput("choice1", "First choice:",1:5,selected=NULL),

         #Create second dropdown box
         selectInput("choice2",  p("Then, make your ", tags$br(), tags$small("second choice")), c("a","b","c","d","e"))
      ),
      dashboardBody()
   ) 
)

server.R:

# Load libraries needed for app
library(shiny)
library(shinydashboard)

# Define server for the Shiny app
shinyServer(function(input, output,session) {
   # populate second dropdown box when a choice in first dropdown box is made
   observe({
      updateSelectInput(session, "choice2", p("Then, make your ", tags$br(), tags$small("second choice")), c("a","b","c","d","e"))
   })
}) 

Answer 1

您的描述/代码中不清楚您想要完成什么。话虽如此，您需要注意更改 updateSelectInput 中的标签，因此无需在更新命令中重复标签。您的observe( 中也没有输入，它什么也不做。我将代码更改为对input$choice1 使用react，但是您需要添加一些代码来更新choice2 中的选择。

您还可以使用 renderUI/uiOutput 来更新服务器中的控件，然后您将避免标签问题。

# Load libraries needed for app
library(shiny)
library(shinydashboard)

# Define server for the Shiny app
server <- shinyServer(function(input, output,session) {
   # populate second dropdown box when a choice in first dropdown box is made
   observeEvent( input$choice1  ,{
      updateSelectInput(session = session,
                        inputId =  "choice2",
                       # label = p("Then, make your ", tags$br(), tags$small("second choice")),
                        choices = c("a","b","c","d","e"))
   })
}) 


# Define the overall UI with a dashboard page template
ui <- shinyUI(
   dashboardPage(
      dashboardHeader(title = "dashboard header"),
      dashboardSidebar( 
         #Create first dropdown box
         selectInput(inputId = "choice1",
                     label = "First choice:",
                     choices = 1:5,
                     selected=NULL),

         #Create second dropdown box
         selectInput(inputId = "choice2",
                     label = p("Then, make your ",    tags$br(),  tags$small("second choice")),
                     choices =  c("a","b","c","d","e"))
      ),
      dashboardBody()
   ) 
)

shinyApp(ui, server)