r - 如何在 Rstudio 中添加多个 bsPopovers 而不会覆盖?
问题描述
最后一个弹出框覆盖所有其他弹出框
我想在shinydashboard 内的几个ValueBoxes 上添加多个弹出框。我正在为每个盒子使用具有唯一 ID 的 bsPopover()。但是,我将所有弹出框都写在一个帮助文件中,并在我的 ui.r 问题中调用此文件的源代码,最后一个弹出框覆盖了所有内容,在 userInterface 上我只能看到我添加的最后一个弹出框。
助手.r
bsPopover(
id = "one", title = "ONE",
content = "blah blah blah 1",
trigger = "hover",
placement = "right",
options = list(container="body"))
bsPopover(
id = "two", title = "TWO",
content = "blah blah blah 2",
trigger = "hover",
placement = "right",
options = list(container="body"))
bsPopover(
id = "three", title = "THREE",
content = "blah blah blah 3",
trigger = "hover",
placement = "bottom",
options = list(container="body"))
用户界面
source("helper.r"),
解决方案
您必须将它们包装在 alist()
中才能正常工作:
library(shiny)
library(shinydashboard)
library(shinyBS)
writeLines(text = 'myPopovers = list(
bsPopover(
id = "one", title = "ONE",
content = "blah blah blah 1",
trigger = "hover",
placement = "right",
options = list(container="body")),
bsPopover(
id = "two", title = "TWO",
content = "blah blah blah 2",
trigger = "hover",
placement = "right",
options = list(container="body")),
bsPopover(
id = "three", title = "THREE",
content = "blah blah blah 3",
trigger = "hover",
placement = "bottom",
options = list(container="body"))
)', con = "helper.R")
source("helper.R")
ui <- dashboardPage(
dashboardHeader(title = "Value boxes"),
dashboardSidebar(),
dashboardBody(
fluidRow(
valueBoxOutput("one"),
valueBoxOutput("two"),
valueBoxOutput("three"),
myPopovers
)
)
)
server <- function(input, output) {
output$one <- renderValueBox({
valueBox(
"25%", "Progress", icon = icon("list"),
color = "purple"
)
})
output$two <- renderValueBox({
valueBox(
"80%", "Approval", icon = icon("thumbs-up", lib = "glyphicon"),
color = "yellow"
)
})
output$three <- renderValueBox({
valueBox(
"90%", "Approval", icon = icon("thumbs-up", lib = "glyphicon"),
color = "green"
)
})
}
shinyApp(ui, server)
结果: