闪亮：将弹出窗口添加到数据表中的列名

Question

我正在尝试向 dabletable 中的列名称添加一个按钮，并在鼠标悬停时向该按钮添加一个 bsPopover。我可以在数据表之外成功创建弹出窗口和按钮，并且可以将按钮添加到数据表中。但是让弹出窗口在数据表中工作已被证明是不成功的。我选择 'hover' 作为触发器，以便单击保留列排序功能。任何帮助或指导表示赞赏。请参阅下面的 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)

Answer 1

请考虑使用 {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 实用程序：

有demos you can explore spsComps and docs篇可以阅读。

闪亮：将弹出窗口添加到数据表中的列名

Shiny: Add Popover to Column Name in Datatable

datatable

r

shiny