r - How to add a hover-over tooltip to rhandonstable header cell? - Stack Overflow

I'm trying to add a tooltip when the user hovers the cursor over the rendered table column header "Percent", in the second column. I've been fiddling with HTML, the onRender() function, with no luck yet. Any idea how to do this?

Here is example code, where I would like to add a hover-over tooltip over the header cell containing "Percent":

library(shiny)
library(rhandsontable)

ui <- fluidPage(
  rHandsontableOutput("table")
)

server <- function(input, output, session) {

  csTbl_display <- reactive({
    data.frame(
      Step = c("A", "B", "Total"),
      Percent = c(0.25, 0.75, 1.00)
    )
  })

  output$table <- renderRHandsontable({
    rhandsontable(csTbl_display(), rowHeaders = NULL) %>%
      hot_col("Step", readOnly = TRUE) %>%
      hot_col("Percent", format = "0.00", readOnly = TRUE) %>%
      htmlwidgets::onRender("
        function(el, x) {
        // I figure the tooltip code goes here?
        }
      ")
  })
}

shinyApp(ui, server)

I'm trying to add a tooltip when the user hovers the cursor over the rendered table column header "Percent", in the second column. I've been fiddling with HTML, the onRender() function, with no luck yet. Any idea how to do this?

Here is example code, where I would like to add a hover-over tooltip over the header cell containing "Percent":

library(shiny)
library(rhandsontable)

ui <- fluidPage(
  rHandsontableOutput("table")
)

server <- function(input, output, session) {

  csTbl_display <- reactive({
    data.frame(
      Step = c("A", "B", "Total"),
      Percent = c(0.25, 0.75, 1.00)
    )
  })

  output$table <- renderRHandsontable({
    rhandsontable(csTbl_display(), rowHeaders = NULL) %>%
      hot_col("Step", readOnly = TRUE) %>%
      hot_col("Percent", format = "0.00", readOnly = TRUE) %>%
      htmlwidgets::onRender("
        function(el, x) {
        // I figure the tooltip code goes here?
        }
      ")
  })
}

shinyApp(ui, server)

• r
• shiny
• tooltip
• rhandsontable

Share Follow asked Mar 4 at 8:58 Village.IdyotVillage.Idyot 2,12155 silver badges1717 bronze badges

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 1

This can be done, if you follow this great example

library(shiny)
library(rhandsontable)
library(htmltools)

ui <- fluidPage(
  tagList(
    rhandsontable(
      data = data.frame(
        Step = c("A", "B", "Total"),
        Percent = c(0.25, 0.75, 1.00)
      ),
      rowHeaders = NULL,
      afterGetColHeader = htmlwidgets::JS(htmltools::HTML(
        sprintf(
          "
            function(i, TH) {
              var titleLookup = %s; 
              if(TH.hasOwnProperty('_tippy')) {TH._tippy.destroy()} // destroy previous tippy instance if it exists
              tippy(TH, {                                           // initialize tooltip and set content to description from our titleLookup
                content: titleLookup[i].desc,
              });
            }
            ",
          jsonlite::toJSON(
            data.frame(
              loc = c("[, 1]", "[, 2]"),
              id =  c("Step" , "Percent"),
              desc = c(""    , "Percent hihi")
            ),
            auto_unbox = TRUE
          )
        )
      ))
    ),
    tags$script(src = "https://unpkg/@popperjs/core@2"),
    tags$script(src = "https://unpkg/tippy.js@6")
  )
)

server <- function(input, output, session) {}

shinyApp(ui, server)

Another way

You can also do this fully manually by adding event listeners to the correct table headers. In below code we have to search for elements with classname 'relative' and then select the third which seems to be the header for Percent. We can then add event listeners to this header and display a tooltip on the hover event which follows the mouse pointer.

library(shiny)
library(rhandsontable)

ui <- fluidPage(
  rHandsontableOutput("table")
)

server <- function(input, output, session) {
  
  csTbl_display <- reactive({
    data.frame(
      Step = c("A", "B", "Total"),
      Percent = c(0.25, 0.75, 1.00)
    )
  })
  
  output$table <- renderRHandsontable({
    rhandsontable(csTbl_display(), rowHeaders = NULL) %>%
      hot_col("Step", readOnly = TRUE) %>%
      hot_col("Percent", format = "0.00", readOnly = TRUE) %>%
      htmlwidgets::onRender("
        function(el, x) {
          // Wait for the table to be fully rendered
          setTimeout(function() {
            var headers = el.getElementsByClassName('relative'); // Find the header cells
            if (headers.length > 0) {
              var percentHeader = headers[3]; // percent is the 3rd one
              
              if (percentHeader) {
                var tooltip = document.createElement('div');
                tooltip.innerHTML = 'Percentage values for each step';
                tooltip.style.display = 'none';
                tooltip.style.position = 'absolute';
                tooltip.style.backgroundColor = 'black';
                tooltip.style.color = 'white';
                tooltip.style.padding = '5px';
                tooltip.style.borderRadius = '3px';
                tooltip.style.zIndex = '1000';
                
                document.body.appendChild(tooltip);
                
                percentHeader.addEventListener('mouseover', function(e) {
                  console.log('hover over');
                  tooltip.style.display = 'block';
                  tooltip.style.left = (e.pageX + 10) + 'px';
                  tooltip.style.top = (e.pageY + 10) + 'px';
                });
                
                percentHeader.addEventListener('mouseout', function() {
                  tooltip.style.display = 'none';
                });
              }
            }
          }, 100);  
        }
      ")
  })
}

shinyApp(ui, server)