Tooltip or Popover in Shiny Datatables for Row Names

tooltip or popover in Shiny datatables for row names?

This code works but running in client side mode. To make it simpler I have used the first five rows of the iris dataset, but I guess the idea is clear. If you hover over the row names the tooltip will be displayed.

ui.R

    library(shiny)
    library(DT)
    shinyUI(
            mainPanel(
                    DT::dataTableOutput("tbl")
            )   
    )    

server.R

    library(shiny)
    library(DT)
    shinyServer(function(input, output,session) {
            output$tbl = DT::renderDataTable(
                    datatable(iris[1:5, ], callback = JS("
                                    var tips = ['First row name', 'Second row name', 'Third row name',
                                    'Fourth row name', 'Fifth row name'],
                                    firstColumn = $('#tbl tr td:first-child');
                                    for (var i = 0; i < tips.length; i++) {
                                    $(firstColumn[i]).attr('title', tips[i]);
                                    }")), server = FALSE)
    }) 

Shiny: Add Popover to Column Name in Datatable

Please consider using alternatives of {shinyBs}.

I would recommend you to try my package {spsComps} which has similar bsPopover functions but with a lot more you can do, like color, opacity, font size, weight, etc.

shinyBs has not been updated for more than 5 years, I am sure you know what it means. It is not me trying to advertise my package so say something bad about shinyBs. I developed these functions because I don't see them in other packages or they didn't keep updating the package.

Here is the use case for your example:

library(shiny)
library(spsComps)
library(DT)
library(dplyr)
# define the question button in a button since we need to uses multiple times
infoBtn <- function(id) {
    actionButton(id,
                 label = "",
                 icon = icon("question"),
                 style = "info",
                 size = "extra-small",
                 class='btn action-button btn-info btn-xs shiny-bound-input'
    )
}
ui <- fluidPage(
    titlePanel('Making a Popover Work in DataTable'),
    mainPanel(
        fluidRow(
            #popover button
            infoBtn('workingPop') %>% 
                bsPopover(title = "This Popover Works",
                      content = "It works very well",
                      placement = "right",
                      trigger = "hover"
                )
        ),
        fluidRow(dataTableOutput('myTable'))
    )
)

server <- function(input, output, session) {
    output$myTable <- DT::renderDataTable({
        # construct the title and convert to text
        hp_text <- tags$span(
            "hp", 
            infoBtn('notWorking') %>% 
                bsPopover(title = "This one does not work",
                          content = "I'd like to give information about hp: it means horsepower. I want a popover, because my real example has lot's of text.",
                          placement = "top",
                          trigger = "hover")
        ) %>% 
            as.character()
        # use !! and := to inject variable as text
        datatable(mtcars %>% rename(!!hp_text:=hp),
                  rownames=TRUE,
                  selection='none',
                  escape=FALSE)
    })
}

shinyApp(ui = ui, server = server)

other popOver utilities you can do with spsComps:

There are demos you can explore spsComps and docs you can read.

Shiny datatable Tooltip/popover not working with paging

I would try with the rowCallback:

rowCallback <- c(
  "function(row, data, displayNum, displayIndex){",
  sprintf("  var tips = [%s];", 
          paste0("'",unlist(DrugFilter()),"'",collapse=",")),
  "  for(var i = 0; i < tips.length; i++){",
  "    if(displayIndex== i){",
  "      $('td:eq(0)',row).attr('title', tips[i]);",
  "    }",
  "  }",
  "}"
)

datatable(Extraction(), 
          rownames = FALSE, 
          escape = FALSE, 
          options = list(
            rowCallback = JS(rowCallback)
          )
)

R shiny Datatable with Reactive Columns and Popover Tooltips

Just combine two javascript code that you provided in one datatable function. This should work:

library(shiny)
library(DT)

ui<-shinyUI(
  mainPanel(
    DT::dataTableOutput("tbl")
  )   
) 

server<-shinyServer(function(input, output,session) {
  shinyInput <- function(FUN, len, id, ivals, ...) {
    inputs <- numeric(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(
        FUN(paste0(id, i), label = NULL,
            value=ivals[i],...)
      )
    }
    inputs
  }
  
  it_df <- reactive({
    data.frame(
      Parameters = rep("X",5),
      Values = shinyInput(numericInput, 5,
                          'param_values', 
                          numeric(5),
                          width = '100%'),
      stringsAsFactors = FALSE
    )
  })
  output$tbl = DT::renderDataTable(
    datatable(it_df(), escape = FALSE, options = list(
      preDrawCallback = JS("function() { Shiny.unbindAll(this.api().table().node());}"),
      drawCallback = JS("function() { Shiny.bindAll(this.api().table().node());}")
    ),
    callback = JS("
                                    var tips = ['First row name', 'Second row name', 'Third row name',
                                    'Fourth row name', 'Fifth row name'],
                                    firstColumn = $('#tbl tr td:first-child');
                                    for (var i = 0; i < tips.length; i++) {
                                    $(firstColumn[i]).attr('title', tips[i]);
                                    }")), server = FALSE)
}) 

shinyApp(ui = ui, server = server)

Shiny tooltips / spsComps

Change this on your UI:

    mainPanel(
        fluidRow(dataTableOutput('myTable')),
        spsDepend("pop-tip")
    )

So here, we add spsDepend("pop-tip"). This means loading the dependent Javascript library when app starts. In therory, -v-, the dependency would be automatically added, users do not need to know this. However, in this case, you are using the renderDataTable function. This package does not know how to handle htmltools::htmlDependency, which is the mechanism how usually developers add JS dependencies for shiny apps.

In your case, if you only use it once in the renderDataTable, we need to manually add the dependency in UI by spsDepend. But like your second case, if it has been used at least once in the UI, the dependency is there, you don't need to worry.

You can see the question mark for the button is not working either. The same problem. renderDataTable does not know how to add the dependency for actionButton. So in general, I wouldn't call it a bug, but a feature DT package doesn't support yet.

For the question mark, even if is not a problem caused by spsComps, but we do have a solution from spsComps, adding the icon library:

    mainPanel(
        fluidRow(dataTableOutput('myTable')),
        spsDepend("pop-tip"),
        spsDepend("font-awesome")
    )

R shiny mouseover text for table columns

To expand my comment above, here is an example showing what I meant by using the title attributes:

library(DT)
sketch = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th('', title = 'Row Names'),
      th('Sepal.Length', title = 'The Sepal Length'),
      th('Sepal.Width', title = 'The Sepal Width'),
      th('Petal.Length', title = 'The Petal Length'),
      th('Petal.Width', title = 'The Petal Width'),
      th('Species', title = 'Iris Species')
    )
  )
))
datatable(iris, container = sketch)

And here is another approach using JavaScript (jQuery) to add the title attributes:

library(DT)
datatable(iris, callback = JS("
var tips = ['Row Names', 'The Sepal Length', 'The Sepal Width',
            'The Petal Length', 'The Petal Width'],
    header = table.columns().header();
for (var i = 0; i < tips.length; i++) {
  $(header[i]).attr('title', tips[i]);
}
"))

---

Related Topics