shinyBS中的动态弹出或工具提示

Question

The idea

我在一个闪闪发亮的应用程序中有一个box()。box()包括一个title参数(依次包括一个icon)和一个selectInput()元素。在胡佛icon上，我希望有一个工具提示(使用tipify())或一个弹出器(使用popify())，根据selectInput()输入生成title或content参数(或两者兼有)。

问题

tipify()和popify()都没有正确地实现textOutput()作为它们的title或content参数。它们需要一个字符串，所以我尝试使用一个reactiveValues()元素作为函数参数，但它也失败了。

问题

仅仅使用r就能使工具提示或弹出内容动态化吗？这是怎么做到的呢？

我怀疑这可以用JavaScript来完成，但我对此知之甚少。

代码

尝试1-失败-显示代码而不是实际文本

library("shiny")
library("shinydashboard")
library("shinyBS")

ui <- fluidPage(
 box(
   title = span("My box",
                tipify(el = icon(name = "info-circle", lib = "font-awesome"), title = textOutput("TIP"))),
   selectInput(
     inputId = "SELECT",
     label = NULL,
     choices = c("Option1" = "Option1",
                 "Option2" = "Option2"
     ),
     multiple = FALSE
   )
 )
)
server <- function(input, output, session){
  output$TIP <- renderText({"Helo world!"})
}
shinyApp(ui, server)

尝试2-失败-无法创建UI提示(reactiveValues())尚未定义

library("shiny")
library("shinydashboard")
library("shinyBS")

ui <- fluidPage(
 box(
   title = span("My box",
                tipify(el = icon(name = "info-circle", lib = "font-awesome"), title = TIP$a)),
   selectInput(
     inputId = "SELECT",
     label = NULL,
     choices = c("Option1" = "Option1",
                 "Option2" = "Option2"
     ),
     multiple = FALSE
   )
 )
)
server <- function(input, output, session){
  TIP <- reactiveValues(a = "Hello world!")
}
shinyApp(ui, server)

Here是一个类似的问题，但它不能解决这里描述的问题。

Answer 1

可以做的是完全在服务器端创建标题。这样你就可以让它变得动态了。这可以给你这样的应用程序：

library("shiny")
library("shinydashboard")
library("shinyBS")

ui <- fluidPage(
  box(
    title = uiOutput("title"),
    selectInput(
      inputId = "SELECT",
      label = NULL,
      choices = c("Option1" = "Option1",
                  "Option2" = "Option2"
      ),
      multiple = FALSE
    )
  )
)
server <- function(input, output, session){
  TIP <- reactiveValues()
  observe({
    TIP$a <- ifelse(input$SELECT =="Option1","Hello World","Hello Mars")
  })


  output$title <- renderUI({span("My box",
                   tipify(el = icon(name = "info-circle", lib = "font-awesome"), title = TIP$a))})


}
shinyApp(ui, server)

希望能帮上忙。