用於行名稱的Shiny數據表中的工具提示或彈出窗口？

Question

當用戶將數據表的行名稱懸停/點擊時，我一直試圖包含類似工具提示或popover的附加信息，因此他們不必查找某些定義，我目前在不同的tabPanel。 這是一個有效的例子：

server.R：

library(shiny)
library(DT)
library(shinyBS)

# Define server for the Shiny app
shinyServer(function(input, output,session) {

tdata <- as.data.frame(iris)

# Render table here 
output$mytable <- DT::renderDataTable(DT::datatable(

   tdata[1:5,],

   options = list(paging = FALSE, searching = FALSE, info = FALSE, sort = FALSE,
                 columnDefs=list(list(targets=1:4, class="dt-right")) ),

   rownames = paste("rowname",1:5),

   container = htmltools::withTags(table(
      class = 'display',
      thead(
         tr(lapply(rep(c('ratios','name1', 'name2', 'name3','name4','name5'), 1),th))
      )
   ))
))

}) # end of shinyServer function

ui.R：

library(shiny)
library(DT)
library(shinyBS)

shinyUI(
   mainPanel(
      DT::dataTableOutput("mytable")
   )   
)      

請注意，我已經看到了以下討論主題，但沒有成功： 用於表列的R閃亮鼠標懸停文本 ，以及在閃亮應用程序中將引導工具提示添加到列標題所以我在思考DT-package選項中的某些內容，或者使用shinyBS包的東西（比如'bsTooltip'）或添加一些HTML或JS。 在數據表中，Shiny似乎沒有自然支持這個工具提示/彈出功能......！

Answer 1

此代碼有效，但在客戶端模式下運行。 為了簡單起見，我使用了虹膜數據集的前五行，但我想這個想法很清楚。 如果將鼠標懸停在行名稱上，將顯示工具提示。

ui.R

    library(shiny)
    library(DT)
    shinyUI(
            mainPanel(
                    DT::dataTableOutput("tbl")
            )   
    )    

server.R

    library(shiny)
    library(DT)
    shinyServer(function(input, output,session) {
            output$tbl = DT::renderDataTable(
                    datatable(iris[1:5, ], callback = JS("
                                    var tips = ['First row name', 'Second row name', 'Third row name',
                                    'Fourth row name', 'Fifth row name'],
                                    firstColumn = $('#tbl tr td:first-child');
                                    for (var i = 0; i < tips.length; i++) {
                                    $(firstColumn[i]).attr('title', tips[i]);
                                    }")), server = FALSE)
    }) 

Answer 2

它不起作用，因為您的代碼沒有使用title屬性，該屬性用於在懸停時顯示標簽。

container = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(lapply(rep(c('ratios','name1', 'name2', 'name3','name4','name5'), 1),th))
  )
))
# OUTPUT OF CONTAINER
#<table class="display">
#  <thead>
#    <tr>
#      <th>ratios</th>
#      <th>name1</th>
#      <th>name2</th>
#      <th>name3</th>
#      <th>name4</th>
#      <th>name5</th>
#    </tr>
#  </thead>
#</table>

我將您的代碼更改為以下（使用title屬性），現在它應該工作：

使用columnLabels <- paste0("label", 1:6)設置columnLabels <- paste0("label", 1:6)而不是僅更改容器。

  # Render table here 
  output$mytable <- DT::renderDataTable({
    columnLabels <- paste0("label", 1:6)

    DT::datatable(
      tdata[1:5,],

      options = list(paging = FALSE, searching = FALSE, info = FALSE, sort = FALSE,
                     columnDefs=list(list(targets=1:4, class="dt-right")) ),

      rownames = paste("rowname",1:5),

      container = htmltools::withTags(table(
        class = 'display',
        thead(
          #tags$th(title=active_columns[i], colnames(data)[i])
          tr(apply(data.frame(colnames=c('ratios','name1', 'name2', 'name3','name4','name5'), labels=columnLabels), 1,
                   function(x) th(title=x[2], x[1])))
        )
      ))
    )
  })
# OUTPUT OF CONTAINER
#<table class="display">
#  <thead>
#    <tr>
#      <th title="label1">ratios</th>
#      <th title="label2">name1</th>
#      <th title="label3">name2</th>
#      <th title="label4">name3</th>
#      <th title="label5">name4</th>
#      <th title="label6">name5</th>
#    </tr>
#  </thead>
#</table>