如何将工具提示添加到 R shiny 中的数据表行名?

How to add tooltips to datatable rownames in R shiny?

我想在 R Shiny 中向数据table 输出添加一些工具提示。

我知道这个主题已经有一些问题,但我找不到任何适合我的代码的问题(我是 R/Shiny 的新手)。问题比较简单。我有一个 table,里面有一些颜色编码,我想向行名添加工具提示,它提供了一些定义和解释。 因此,我创建了下面的代码,它生成了一个包含 6 行的虚拟 table,我想将工具提示添加到行名 4,5 和 6.

library(DT)

server <- function(input, output) {
  output$output_table <- DT::renderDataTable({

    table <- data.frame(row.names = c('rowname1','rowname2','rowname3','rowname4','rowname5','rowname6')
                        , value1=c(0,3.5,1,4,0.5,5)
                        , value2=c(0,1,0,1.1,1,1.4)
                        , index1=c(0,1,0.5,1,0,0)
                        , index2=c(0.5,0,0.5,1,1,1)
    )
    le_table = datatable(table
                         , colnames = NULL
                         , options = list(dom='t'
                                          , ordering=FALSE
                                          , columnDefs = list(list(targets = c(3,4), visible = FALSE)))) %>%
      formatStyle(colnames(table[1]), colnames(table[3]),backgroundColor = styleEqual(c(0, 0.5, 1), c('red', 'orange', 'green'))) %>% 
      formatStyle(colnames(table[2]), colnames(table[4]),backgroundColor = styleEqual(c(0, 0.5, 1), c('red', 'orange', 'green')))

    le_table
  })
}

ui <- fluidPage(
  DT::dataTableOutput("output_table")
)

shinyApp(ui = ui, server = server)

如果有人能帮我解决这个问题,我将不胜感激,因为我现在完全迷路了。

rowCallback:

library(DT)

table <- data.frame(
  row.names = c('rowname1','rowname2','rowname3','rowname4','rowname5','rowname6')
  , value1=c(0,3.5,1,4,0.5,5)
  , value2=c(0,1,0,1.1,1,1.4)
  , index1=c(0,1,0.5,1,0,0)
  , index2=c(0.5,0,0.5,1,1,1)
)

rowCallback <- c(
  "function(row, data, num, index){",
  "  if(index === 3){",
  "    $('td:eq(0)', row).attr('title', 'a tooltip for row 4');",
  "  }else if(index === 4){",
  "    $('td:eq(0)', row).attr('title', 'a tooltip for row 5');",
  "  }else if(index === 5){",
  "    $('td:eq(0)', row).attr('title', 'a tooltip for row 6');",
  "  }",
  "}"  
)

le_table = datatable(
  table
  , colnames = NULL
  , options = list(
    dom='t'
    , ordering=FALSE
    , columnDefs = list(list(targets = c(3,4), visible = FALSE))
    , rowCallback = JS(rowCallback))
) %>%
  formatStyle(colnames(table[1]), colnames(table[3]), 
              backgroundColor = styleEqual(c(0, 0.5, 1), c('red', 'orange', 'green'))) %>% 
  formatStyle(colnames(table[2]), colnames(table[4]), 
              backgroundColor = styleEqual(c(0, 0.5, 1), c('red', 'orange', 'green')))

le_table