Search code examples
rshinydthtmlwidgetssparklines

Include sparkline htmlwidget in datatable cells in a Shiny app, without resorting to (much) JavaScript

I am using the sparkline package to produce bar charts to place into cells of a datatable in a Shiny app. I've managed to produce the desired output in a standalone datatable, but when I place it into the Shiny app it doesn't work. It may have something to do with how spk_add_deps() identifies the htmlwidgets. I've tried moving the spk_add_deps() function around quite a bit and passing it various identifiers, and nothing worked.

I did find essentially the same question here Render datatable with sparklines in Shiny but the given solution (1) relies on writing the JavaScript code for the sparklines in a callback function (defeating the purpose of having the R sparkline() function) and (2) it seems that if the sparklines render in the viewer then we can't be all that far off from getting them to render in the Shiny app without having to write all that JavaScript.

Here's the demo:

# Preliminary, load packages and build a demo table with the sparkline code merged in
library(shiny)
library(DT)
library(data.table)
library(sparkline)

## Create demo data sets
my_mtcars <- data.table(mtcars, keep.rownames = TRUE)
names(my_mtcars)[1] <- 'car_id'

set.seed(0)
data_for_sparklines <- data.table(car_id = rep(my_mtcars$car_id, 5),
                                  category = 1:5,
                                  value = runif(160))

sparkline_html <- data_for_sparklines[, .(sparkbar = spk_chr(value, type = 'bar')), by = 'car_id']
my_mtcars <- merge(my_mtcars, sparkline_html, by = 'car_id')

Now if I render the datatable on its own the sparkline bar graphs do appear:

spk_add_deps(datatable(my_mtcars, escape = FALSE))

datatable showing sparkline bar charts

But if I embed the same into a Shiny app that column is blank:

ui <- shinyUI(fluidPage(
  dataTableOutput('myTable')
))

server <- shinyServer(function(input, output, session) {
  output$myTable <- renderDataTable(spk_add_deps(datatable(my_mtcars, escape = FALSE)))
}) 

shinyApp(ui = ui, server = server)

enter image description here

Solution

  • Found a solution, using the htmlwidgets package.

    library(htmlwidgets)

    Then instead of spk_add_deps() use getDependency() to load the sparkline dependencies in the Shiny UI function:

    ui <- shinyUI(fluidPage(
  getDependency('sparkline'),
  dataTableOutput('myTable')
))

    And for reasons I don't fully understand, add a callback in renderDataTable() to the HTMLwidgets staticRender() function:

    server <- shinyServer(function(input, output, session) {
  staticRender_cb <- JS('function(){debugger;HTMLWidgets.staticRender();}') 
  output$myTable <- renderDataTable(my_mtcars,
                                    escape = FALSE,
                                    options = list(drawCallback = staticRender_cb))
})

    But that's it, that's all it takes to get them to render in a Shiny app.