Hover Shiny 應用程序的 DT 數據表中動態列標題的工具提示/彈出框

Question

您好，我有一個 Shiny 應用程序，它允許用戶 select 他們希望在表格中看到的列。 當用戶將鼠標懸停在每個列名稱上時，如何添加工具提示/彈出窗口以顯示一些文本？ 理想情況下，我希望它在 header 旁邊顯示一個“i”信息圖標。

我偶然發現了允許 static 表彈出窗口的解決方案，但不允許動態彈出窗口。

該應用程序目前看起來像這樣：

應用程序代碼如下：

library(shiny)
library(DT)

# Create data frame
column_names <- c(toupper(letters[1:26]),tolower(letters[1:26]))
df <- data.frame(replicate(length(column_names),sample(0:1,1000,rep=TRUE)))

# assign column names
colnames(df) = column_names


ui <- fluidPage(
  
  mainPanel(
    column(2,
           pickerInput(
             "UpperCase",
             h4("Upper case"),
             choices = column_names[1:26],
             multiple = TRUE,
             selected = c("A", "E", "J", "Z"),
             options = list(
               style = "my-class",
               title = "Select fields to display",
               `actions-box` = TRUE,
               size = 5),
             choicesOpt = list(
               style = rep_len("font-size: 75%; line-height: 1.6;", length(column_names[1:26])))
           )),
    
    # transaction detail column picker
    column(2,
           pickerInput(
             "LowerCase",
             h4("Lower Case"),
             choices = column_names[27:52],
             multiple = TRUE,
             selected = c("a", "g", "h", "b"),
             options = list(
               style = "my-class",
               title = "Select fields to display",
               `actions-box` = TRUE,
               size = 5),
             choicesOpt = list(
               style = rep_len("font-size: 75%; line-height: 1.6;", length(column_names[27:52])))
           ))
  ),
  
  DT::dataTableOutput("alphabet")
)



# Define server logic required to draw a histogram
server <- function(input, output) {
  
  output$alphabet <- DT::renderDT({
    columns = column_names
    if (!is.null(input$UpperCase)&!is.null(input$LowerCase)) {
      columns = c(input$UpperCase,input$LowerCase)
    }
    datatable(
      df %>% select(columns),
      class = "row-border hover stripe",
      rownames = FALSE
    )
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

謝謝！

Answer 1

我在評論中使用了相同的方法，但進行了更改以匹配您選擇的列。 您可以有一個列描述的命名向量，並將其作為要顯示在var tips上的值

server <- function(input, output) {
  
  output$alphabet <- DT::renderDT({
    columns = column_names
    if (!is.null(input$UpperCase)&!is.null(input$LowerCase)) {
      columns = c(input$UpperCase,input$LowerCase)
    }
    datatable(
      df %>% select(columns),
      class = "row-border hover stripe",
      rownames = FALSE,
      callback = JS(paste0("
var tips = ['",paste0(columns,collapse = "','"),"'],
    header = table.columns().header();
for (var i = 0; i < tips.length; i++) {
  $(header[i]).attr('title', tips[i]);
}
"))
    )
  })
}