如何向 R shiny 中的數據表行名添加工具提示？

Question

我想在 R Shiny 中的數據表 output 中添加一些工具提示。

我知道這個話題已經有一些問題了，但是我找不到任何適用於我的代碼的問題（我對 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