Как добавить всплывающие подсказки к именам строк в R блестящий?

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