Composited Sparkline in R with DT and Shiny

问题

I have got a reference by leonawicz that can combine sparkline and DT perfectly(Many thanks for him). But, could you please give me a help to make a composited sparkline? Thanks a lot!.

Here is the sample code

library(data.table)
library(DT)
library(sparkline)
Data <- data.table(Type = c("A", "B", "C"),
               Value_1 = c("1,1,2,2", "2,2,3,3", "3,3,4,4"), 
               Value_2 = c("0,1,2,3", "2,3,4,5", "4,5,6,7"))
r <- c(0, 8)
line_string <- "type: 'line', lineColor: 'black', fillColor: '#ccc', 
               highlightLineColor: 'orange', highlightSpotColor: 'orange', 
               width: 80,height: 60"
cb_line = JS(paste0("function (oSettings, json) { 
            $('.spark:not(:has(canvas))').sparkline('html', { ", 
                line_string, ", chartRangeMin: ", r[1], ", chartRangeMax: ", 
                r[2], " }); }"), collapse = "")
cd <- list(list(targets = 1:2, render = JS("function(data, type, full){ 
           return '<span class=spark>' + data + '</span>' }")))
d1 <- datatable(Data, rownames = FALSE, options = list(columnDefs = cd,                                                       
                                              fnDrawCallback = cb_line))
d1$dependencies <- append(d1$dependencies, 
                          htmlwidgets:::getDependency("sparkline"))
d1

How could composite Value_1 and Value_2 into 1 sparkline chart? Thank you again!

回答1:

First of all you are making it difficult on yourself. What you achieved with all that JS code can be easily reproduced in a more R way using the functions sparkline gives us (you are literally not using the sparkline package at all if not for adding the dependency):

Data:

The data you are using doesn't make much sense to me. It should be organized in a tidier way (one variable per column, one observation per row).

So I converted it:

dfO <- data.frame(Type = c("A", "B", "C"),
                   Value_1 = c("1,1,2,2", "2,2,3,3", "3,3,4,4"), 
                   Value_2 = c("0,1,2,3", "2,3,4,5", "4,5,6,7"))
library(tidyr)
library(dplyr)

df <- dfO %>% 
    separate_rows(Value_1, Value_2) %>% 
    mutate_at(vars(starts_with('Value')) ,funs(as.integer))

df
#>    Type Value_1 Value_2
#> 1     A       1       0
#> 2     A       1       1
#> 3     A       2       2
#> 4     A       2       3
#> 5     B       2       2
#> 6     B       2       3
#> 7     B       3       4
#> 8     B       3       5
#> 9     C       3       4
#> 10    C       3       5
#> 11    C       4       6
#> 12    C       4       7

Simple sparklines

sparkline plays nicely with dplyr, and in particular summarize.
The function spk_char convert the htmlwidget to a string that can be used inside another widget, in this case datatable. Options can be specified directly, no need to use JS.

library(dplyr)
library(sparkline)
library(DT)

df %>% 
    group_by(Type) %>% 
    summarize(l1 = spk_chr(Value_1,
                           lineColor = 'black', 
                           fillColor = '#ccc',
                           chartRangeMin = 0,
                           chartRangeMax = 8,
                           width = 80,
                           height = 60,
                           highlightLineColor = 'orange', 
                           highlightSpotColor = 'orange'),
              l2 = spk_chr(Value_2,
                           lineColor = 'black', 
                           fillColor = '#ccc',
                           chartRangeMin = 0,
                           chartRangeMax = 8,
                           width = 80,
                           height = 60,
                           highlightLineColor = 'orange', 
                           highlightSpotColor = 'orange')) %>% 
    datatable(escape = F,
              rownames = F,
              options = list(fnDrawCallback = htmlwidgets::JS('function(){
                                                              HTMLWidgets.staticRender();
                                                              }'))
    ) %>% 
    spk_add_deps()

Composite sparklines

That said, combining the two sparklines has proved more difficult than I thought it would be. The solution is quite easy, but finding it took a bit.

What I did is:

Split the dataset into groups
Create the sparklines for each group
Combine them using spk_composite
Convert to usable string inside DT using as.character(as.tags(l))

The last step is what is done internally by spk_chr.

library(purrr)
df %>% 
    split(.$Type) %>% 
    map_df(~{
        l1 <- sparkline(.x$Value_1,
                        lineColor = 'black', 
                        fillColor = '#ccc',
                        chartRangeMin = 0,
                        chartRangeMax = 8,
                        width = 80,
                        height = 60,
                        highlightLineColor = 'orange', 
                        highlightSpotColor = 'orange')
        l2 <- sparkline(.x$Value_2,
                        lineColor = 'black', 
                        fillColor = '#ccc',
                        chartRangeMin = 0,
                        chartRangeMax = 8,
                        width = 80,
                        height = 60,
                        highlightLineColor = 'orange', 
                        highlightSpotColor = 'orange')
        l <- spk_composite(l2, 
                           l1) 
        data.frame(l1 = as.character(htmltools::as.tags(l1)), 
                   l2 = as.character(htmltools::as.tags(l2)), 
                   l = as.character(htmltools::as.tags(l)))
    }, .id = 'Type') %>% 
    datatable(escape = F,
              rownames = F,
              options = list(fnDrawCallback = htmlwidgets::JS('function(){
                                               HTMLWidgets.staticRender();
                                                                            }'))
    ) %>% 
    spk_add_deps()

来源：https://stackoverflow.com/questions/43251214/composited-sparkline-in-r-with-dt-and-shiny

标签

Shiny

sparklines