CODEWITHSUNDEEP
rshinydatatablesdt
Dieu94
Dieu94

Reputation: 455

Hover tooltip/popover for dynamic column headers in DT datatable for Shiny app

Hello I have a Shiny app that allows for the user to select the columns that they would like to see in a table. How do I add tooltips/popovers to display some text when the user hovers over each column name? Ideally I would like it to appear with an 'i' information icon next to the header.

I have stumbled across solutions that allow for popovers for static tables, but not dynamic ones.

The app currently looks like this:

enter image description here

The app code below:

library(shiny)
library(DT)

# Create data frame
column_names <- c(toupper(letters[1:26]),tolower(letters[1:26]))
df <- data.frame(replicate(length(column_names),sample(0:1,1000,rep=TRUE)))

# assign column names
colnames(df) = column_names


ui <- fluidPage(
  
  mainPanel(
    column(2,
           pickerInput(
             "UpperCase",
             h4("Upper case"),
             choices = column_names[1:26],
             multiple = TRUE,
             selected = c("A", "E", "J", "Z"),
             options = list(
               style = "my-class",
               title = "Select fields to display",
               `actions-box` = TRUE,
               size = 5),
             choicesOpt = list(
               style = rep_len("font-size: 75%; line-height: 1.6;", length(column_names[1:26])))
           )),
    
    # transaction detail column picker
    column(2,
           pickerInput(
             "LowerCase",
             h4("Lower Case"),
             choices = column_names[27:52],
             multiple = TRUE,
             selected = c("a", "g", "h", "b"),
             options = list(
               style = "my-class",
               title = "Select fields to display",
               `actions-box` = TRUE,
               size = 5),
             choicesOpt = list(
               style = rep_len("font-size: 75%; line-height: 1.6;", length(column_names[27:52])))
           ))
  ),
  
  DT::dataTableOutput("alphabet")
)



# Define server logic required to draw a histogram
server <- function(input, output) {
  
  output$alphabet <- DT::renderDT({
    columns = column_names
    if (!is.null(input$UpperCase)&!is.null(input$LowerCase)) {
      columns = c(input$UpperCase,input$LowerCase)
    }
    datatable(
      df %>% select(columns),
      class = "row-border hover stripe",
      rownames = FALSE
    )
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Thanks!

Upvotes: 2

Views: 1181

Answers (1)

Vida
Vida

Reputation: 398

I'm using the same method at the comment, but changed to match your selected columns. you could have a named vector of columns descriptions and put it as the value to be shown on var tips

server <- function(input, output) {
  
  output$alphabet <- DT::renderDT({
    columns = column_names
    if (!is.null(input$UpperCase)&!is.null(input$LowerCase)) {
      columns = c(input$UpperCase,input$LowerCase)
    }
    datatable(
      df %>% select(columns),
      class = "row-border hover stripe",
      rownames = FALSE,
      callback = JS(paste0("
var tips = ['",paste0(columns,collapse = "','"),"'],
    header = table.columns().header();
for (var i = 0; i < tips.length; i++) {
  $(header[i]).attr('title', tips[i]);
}
"))
    )
  })
}

Upvotes: 2

Related Questions