将 Sparkline htmlwidget 包含在 Shiny 应用程序的数据表单元格中,而无需诉诸(太多)JavaScript

Bri*_*per 6 r sparklines shiny dt htmlwidgets

我正在使用该sparkline包生成条形图,并将其放入datatableShiny 应用程序中的单元格中。我已经设法在独立中产生所需的输出datatable,但是当我将其放入 Shiny 应用程序中时,它不起作用。spk_add_deps()这可能与如何识别 htmlwidgets有关。我尝试过spk_add_deps()多次移动该函数并向其传递各种标识符,但没有任何效果。

我确实在这里发现了本质上相同的问题Render datatable with Sparklines in Shiny 但给定的解决方案 (1) 依赖于在回调函数中为迷你图编写 JavaScript 代码(违背了使用 R 函数的目的sparkline())和 (2) 似乎如果迷你图在查看器中呈现,那么我们离让它们在 Shiny 应用程序中呈现而无需编写所有 JavaScript 就不远了。

这是演示:

# 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')
Run Code Online (Sandbox Code Playgroud)

现在,如果我单独渲染数据表,迷你图条形图就会出现:

spk_add_deps(datatable(my_mtcars, escape = FALSE))
Run Code Online (Sandbox Code Playgroud)

显示迷你条形图的数据表

但如果我将相同的内容嵌入到闪亮的应用程序中,该列将为空白:

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)
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

Bri*_*per 5

找到了解决方案,使用htmlwidgets包。

library(htmlwidgets)
Run Code Online (Sandbox Code Playgroud)

然后,不要spk_add_deps()使用getDependency()Shiny UI 函数加载迷你图依赖项:

ui <- shinyUI(fluidPage(
  getDependency('sparkline'),
  dataTableOutput('myTable')
))
Run Code Online (Sandbox Code Playgroud)

renderDataTable()由于我不完全理解的原因,请在 HTMLwidgets 函数中添加回调staticRender()

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))
}) 
Run Code Online (Sandbox Code Playgroud)

但就是这样,这就是让它们在 Shiny 应用程序中渲染所需的全部。