0

I'm attempting to add popovers with additional information to individual cells of a datatable using shinyBS functions (because I'd like them to be proper popovers and not 'just' the datatable title attributes). ShinyBS::addpopover() requires an element ID for the element to attach a popover to. I've got this working for attaching a popover to an entire datatable, and now for the next step I'm attempting to add popovers at row level (before moving on to cell level) yet I am stuck.

My solution so far is very heavily based on this thread: Insert popify for radiobuttons options

Current problem: Using a rowCallback JS function, each row in the datatable is now given it's own ID (tableRow_x) yet ShinyBS::addpopover() does not seem to recognize these IDs. I suspect it might be possible to add something to the id parameter of addpopover() to get it to find the id's within the datatable, but I haven't been able to figure out what.

reprex:

NB: when running the shiny in an rstudio pop up browser, it is necessary to first click anywhere in the browser before the popovers start showing.

library(shinyBS)
library(shiny)
library(DT)
library(shinyjs) ## needed to tamper with the HTML

ui <- fluidPage(
  useShinyjs(),
  # need to include at least one bs element in ui
  bsTooltip(
    "foo",
    "This tooltip goes nowhere - it's there to make the tooltips defined with addPopover on the server side work"
  ) ,
  
  DTOutput("table")
)

server <- function(input, output, session) {
  
# once the UI is loaded, call shinyBS::addPopover to attach popover to it
session$onFlushed(function() {
    addPopover(session = session,
              id = "DataTables_Table_0",
              title = "information",
              content = "this is the popover on id DataTables_Table_0"
    )
    addPopover(session = session,
               id = "tableRow_3",
               title = "row information",
               content = "this is the popover on id tableRow_3")      
  })
  
  output$table <-
    renderDataTable({
      datatable(data = iris,
                options = list(
                  rowCallback = JS(
                    "function( nRow, aData) {",
                    "$(nRow).attr('id', 'tableRow_' +aData[0]);",
                    "}"
                  )
                ))
            })
}

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

`

Anne-Wil
  • 3
  • 3

2 Answers2

0

It works with server=FALSE and the rowId option instead of rowCallback:

  output$table <-
    renderDT({
      datatable(
        data = iris,
        options = list(
          rowId = JS("function(data){return 'tableRow_' + data[0];}")
        )
      )
    }, server = FALSE)

Didn't try with rowCallback.

Stéphane Laurent
  • 75,186
  • 15
  • 119
  • 225
  • Amazing! Totally didn't think of toggling the server parameter. When server = F, both the rowId and rowCallback options work and indeed shinyBS::popover() adds popovers as expected. Now to fiddle on to cell level - many thanks for getting me past this hurdle! – Anne-Wil Mar 15 '23 at 12:01
  • @Anne-Wil I would use [createdCell](https://datatables.net/reference/option/columns.createdCell) to assign an id to the cells. – Stéphane Laurent Mar 15 '23 at 13:19
0

Thought I'd give one more update (for future reference) before I move on out of reprex territory.

The below version has a modified rowCallback function to assign ID's to the cell in the fourth column of each row. Edit: one more update - using the createdcell function to create the id tags, as suggested by Stéphane Laurent. In the createdcell JS function to the (zero-based) rowindex is increased with 1 to match it with the dataframe row indices for populating content using iris$Petal.Width[row] in a for loop.

In the addpopover() call the option 'container = body' is crucial in order to not make the popover mess up the datatable layout (as a result of plunking the popover div into the datatable).

library(DT)
library(shinyBS)
library(shiny)
library(shinyjs) ## needed to tamper with the HTML

ui <- fluidPage(
  useShinyjs(),
  ## need to include at least one bs element in ui
  bsTooltip(
    "foo",
    "This tooltip goes nowhere - it's there to make the tooltips defined with addPopover on the     server side work"
  ) ,
  
  DTOutput("table")
)

server <- function(input, output, session) {
  
  ## once the UI is loaded, call shinyBS::addPopover to attach popover to it
session$onFlushed(function() {
    addPopover(session,
              id = "DataTables_Table_0",
              title = "information",
              content = "this is the popover on id DataTables_Table_0"
    )
  
    for (row in c(1:nrow(iris))) { 
      addPopover(session,
               id = paste0('cell_', row, '_2'),
               title = "cell information",
               trigger = 'hover',
               content = paste('petal width =', iris$Petal.Width[row]),
               options = list( container='body')) # container= 'body' makes it so that the     popover div doesn't scoot over the next column/mess with the datatable lay-out.
    }
  })
  
  output$table <-
    renderDataTable({
      datatable(data = iris[1:10,],
                options = list(
                 columnDefs = list(
                    list(visible=FALSE, targets=3),
                    list(targets = "_all",
                         createdCell = DT::JS("
                                             function(td, cellData, rowData, row, col) {
                                                    $(td).attr('id', 'cell_'+(row+1)+'_'+col); 
                                             }
                                           ")
                              ))))
        }, server = FALSE) #server = F is crucial for addpopover to find the new IDs
  
}

# Run the application
shinyApp(ui = ui, server = server)
Anne-Wil
  • 3
  • 3