[英]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.