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

Question

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

我知道这个主题已经有一些问题，但我找不到任何适合我的代码的问题(我对 R/Shiny 还很陌生)。问题比较简单。我有一张表，里面有一些颜色编码，我想向行名添加工具提示，它提供了一些定义和解释。因此，我创建了下面的代码，它生成了一个包含 6 行的虚拟表，我想向行名 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)

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

Answer 1

使用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