Include sparkline htmlwidget in datatable cells in

问题:

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))

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)

回答1:

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.

回答2:

FYI to anyone who comes across the initial code in the question and wants to use it without Shiny (as I did), that code only creates sparklines on the first page of a table. You need to add

options = list(
  fnDrawCallback = htmlwidgets::JS(
    '
function(){
  HTMLWidgets.staticRender();
}
'
  )

in the DT::datatable() code if you want the sparklines on all pages of the table.