[英]Shiny: Add Popover to Column Name in Datatable
我正在尝试向 dabletable 中的列名添加一个按钮,并在将鼠标悬停在该按钮上时向该按钮添加一个 bsPopover。 我可以在数据表之外成功创建弹出窗口和按钮,并且可以将按钮添加到数据表中。 但是让 popover 在数据表中工作已被证明是不成功的。 我选择“悬停”作为触发器,以便单击保留列排序功能。 任何帮助或指导表示赞赏。 见下面的reprex:
library(shiny)
library(shinyBS)
library(DT)
ui <- fluidPage(
titlePanel('Making a Popover Work in DataTable'),
mainPanel(
fluidRow(
#popover button
p(bsButton("workingPop",
label = "",
icon = icon("question"),
style = "info",
size = "extra-small")
),
#popover content
bsPopover(id = "workingPop", title = "This Popover Works",
content = "It works very well",
placement = "right",
trigger = "hover",
options = list(container = "body")
)),
fluidRow(dataTableOutput('myTable'),
bsPopover(id="notWorking", title = "This one does not work",
content = "I'd like to give information about hp: it means horsepower. I want a popover, because my real example has lot's of text.",
placement = "top",
trigger = "hover",
options = list(container = "body")))
)
)
server <- function(input, output, session) {
output$myTable <- DT::renderDataTable({
datatable(mtcars %>%
rename("hp <button type='button' id='notWorking' class='btn action-button btn-info btn-xs shiny-bound-input'>
<i class='fa fa-question' role='presentation' aria-label='question icon'></i>
</button>"=hp),
rownames=TRUE,
selection='none',
escape=FALSE)
})
}
shinyApp(ui = ui, server = server)
请考虑使用 {shinyBs} 的替代品。
我建议你试试我的包 { spsComps },它有类似的bsPopover
功能,但你可以做更多的事情,比如颜色、不透明度、字体大小、重量等。
ShinyBs 已经超过 5 年没有更新了,我相信你知道这意味着什么。 不是我试图为我的包裹做广告,所以说一些关于 ShinyBs 的坏话。 我开发这些功能是因为我在其他包中没有看到它们,或者它们没有不断更新包。
这是您的示例的用例:
library(shiny)
library(spsComps)
library(DT)
library(dplyr)
# define the question button in a button since we need to uses multiple times
infoBtn <- function(id) {
actionButton(id,
label = "",
icon = icon("question"),
style = "info",
size = "extra-small",
class='btn action-button btn-info btn-xs shiny-bound-input'
)
}
ui <- fluidPage(
titlePanel('Making a Popover Work in DataTable'),
mainPanel(
fluidRow(
#popover button
infoBtn('workingPop') %>%
bsPopover(title = "This Popover Works",
content = "It works very well",
placement = "right",
trigger = "hover"
)
),
fluidRow(dataTableOutput('myTable'))
)
)
server <- function(input, output, session) {
output$myTable <- DT::renderDataTable({
# construct the title and convert to text
hp_text <- tags$span(
"hp",
infoBtn('notWorking') %>%
bsPopover(title = "This one does not work",
content = "I'd like to give information about hp: it means horsepower. I want a popover, because my real example has lot's of text.",
placement = "top",
trigger = "hover")
) %>%
as.character()
# use !! and := to inject variable as text
datatable(mtcars %>% rename(!!hp_text:=hp),
rownames=TRUE,
selection='none',
escape=FALSE)
})
}
shinyApp(ui = ui, server = server)
您可以使用 spsComps 执行的其他 popOver 实用程序:
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.