Включите спарклайн htmlwidget в ячейки с данными в приложении Shiny, не прибегая (много) к JavaScript.

Я использую пакет sparkline для создания гистограмм для размещения в ячейках datatable в приложении Shiny. Мне удалось получить желаемый результат в автономном datatable, но когда я помещаю его в приложение Shiny, он не работает. Это может иметь какое-то отношение к тому, как spk_add_deps() идентифицирует htmlwidgets. Я пробовал немного перемещать функцию spk_add_deps() и передавать ей различные идентификаторы, и ничего не получалось.

Я нашел по сути тот же вопрос здесь Визуализировать данные со спарклайнами в 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')

Теперь, если я визуализирую данные самостоятельно, появляются гистограммы спарклайнов:

spk_add_deps(datatable(my_mtcars, escape = FALSE))

datatable, показывающий гистограммы спарклайнов

Но если я встрою то же самое в приложение Shiny, этот столбец будет пустым:

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)

введите здесь описание изображения


r sparklines shiny dt htmlwidgets
person Brian Stamper    schedule 31.10.2017    source источник
comment
HTMLwidgets, как правило, работают только с пакетом JS, для которого они были разработаны. Если кто-то специально не создал виджет DT+sparkline в R, я думаю, вам не повезло.   -  person Ryan Morton    schedule 31.10.2017

Ответы (2)


arrow_upward
3
arrow_downward

Нашел решение, используя пакет htmlwidgets.

library(htmlwidgets)

Затем вместо spk_add_deps() используйте getDependency() для загрузки зависимостей спарклайнов в функции Shiny UI:

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

И по причинам, которые я не совсем понимаю, добавьте обратный вызов в 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))
})

Но это все, это все, что нужно, чтобы заставить их отображаться в приложении Shiny.

person Brian Stamper    schedule 01.11.2017

arrow_upward
3
arrow_downward

К сведению всех, кто натолкнется на исходный код в вопросе и захочет использовать его без Shiny (как это сделал я), этот код создает спарклайны только на первой странице таблицы Вам нужно добавить

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

в коде DT::datatable(), если вы хотите, чтобы спарклайны отображались на всех страницах таблицы.

person Sharon    schedule 19.10.2018