Search code examples
cssrshinytooltipdt

How to style a tooltip in a Shiny data table?


I have a data table in a Shiny dashboard that includes tooltips for the data in the first column. Unfortunately, I haven't been able to write working CSS code to style the tooltips, e.g. change the background color. In addition, I would like to have part of the tooltip text in bold, e.g. "Tooltip 1", "Tooltip 2" and "Tooltip 3" in the example below while the remaining text is displayed with normal font weight. I would really appreciate your help.

A minimal example is here:

library(shiny)
library(DT)

df <- as.data.frame(cbind(c("Var1", "Var2", "Var3"), c(10, 5, 45)))
df 

rowCallback <- c(
  "function(row, data, num, index){",
  "  if(index === 0){",
  "    $('td:eq(0)', row).attr('title', 'Tooltip 1: some text');",
  "  } else if(index === 1){",
  "    $('td:eq(0)', row).attr('title', 'Tooltip 2: some text');",
  "  } else if(index === 2){",
  "    $('td:eq(0)', row).attr('title', 'Tooltip 3: some text');",
  "  }",
  "}"  
)


ui <- shiny::basicPage(
  
  div(dataTableOutput('table1'), 
      style="padding-left:50px; padding-right:50px")
  
)

server <- function(input, output) {
  
  output$table1 <- renderDataTable({
    datatable(df, 
              rownames=F,
              options = list(dom = 't', pageLength = 20, 
                             scrollX = T,
                             rowCallback = JS(rowCallback))) 
  })
}
  

shinyApp(ui, server)

Solution

  • Here is an example using Bootstrap 4.

    library(shiny)
    library(DT)
    library(bslib)
    
    
    css <- '
    .tooltip {
      pointer-events: none;
    }
    .tooltip > .tooltip-inner {
      pointer-events: none;
      background-color: #73AD21;
      color: #FFFFFF;
      border: 1px solid green;
      padding: 10px;
      font-size: 25px;
      font-style: italic;
      text-align: justify;
      margin-left: 0;
      max-width: 1000px;
    }
    .tooltip > .arrow::before {
      border-right-color: #73AD21;
    }
    '
    
    initComplete <- "
    function () {
      $('[data-toggle=tooltip]').tooltip();
    }
    "
    
    df <- as.data.frame(cbind(c("Var1", "Var2", "Var3"), c(10, 5, 45)))
    df 
    
    rowCallback <- c(
      "function(row, data, num, index){",
      "  if(index === 0){",
      "    $('td:eq(0)', row).attr('title', '<strong>Tooltip 1:</strong> <br> some text').attr('data-toggle', 'tooltip').attr('data-placement', 'right').attr('data-html', 'true');",
      "  } else if(index === 1){",
      "    $('td:eq(0)', row).attr('title', 'Tooltip 2: some text');",
      "  } else if(index === 2){",
      "    $('td:eq(0)', row).attr('title', 'Tooltip 3: some text');",
      "  }",
      "}"  
    )
    
    
    ui <- fluidPage(
      theme = bs_theme(version = 4),
      tags$head(
        tags$style(HTML(css))
      ),
      
      div(DTOutput('table1'), 
          style="padding-left:50px; padding-right:50px")
      
    )
    
    server <- function(input, output) {
      
      output$table1 <- renderDT({
        datatable(df, 
                  rownames = FALSE,
                  options = list(dom = 't', pageLength = 20, 
                                 scrollX = TRUE,
                                 rowCallback = JS(rowCallback),
                                 initComplete = JS(initComplete))) 
      })
    }
    
    
    shinyApp(ui, server)
    

    enter image description here