使用DT和Shiny在R中合成Sparkline

Question

我有一个leonawicz的reference，可以完美地结合迷你线和DT（非常感谢他）。但是，请你帮我一个复合迷你？非常感谢！。

以下是示例代码

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

如何将Value_1和Value_2合成为1个迷你图？ 再次感谢你！

Answer 1

首先，你让自己变得困难。您使用函数R以sparkline方式更轻松地再现所有JS代码所取得的成果（如果不是为了添加，您根本就不使用sparkline包依赖）：

数据：

您使用的数据对我来说并没有多大意义。它应该以tidyer方式组织（每列一个变量，每行一个观察）。

所以我转换了它：

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

简单的迷你线

sparkline可与dplyr很好地配合使用，特别是summarize。
函数spk_char将htmlwidget转换为可在另一个窗口小部件中使用的字符串，在本例中为datatable。可以直接指定选项，无需使用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()

复合迷你图

那就是说，结合两个sparklines已经证明比我想象的更难。解决方案很简单，但找到它需要一点时间。

我做的是：

• 将数据集拆分为组
• 为每个组创建迷你图
• 使用spk_composite
合并它们
• 使用DT
转换为as.character(as.tags(l))内的可用字符串

最后一步是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()