R 中带有 DT 和 Shiny 的复合迷你图

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

首先，你让自己很难受。使用 sparkline 提供给我们的函数，您可以通过更多 R 方式轻松地复制您使用所有 JS 代码所取得的成果（如果不添加依赖项，您实际上根本没有使用 sparkline 包）：

数据：

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

所以我转换了它：

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 转换为可以在另一个widget 中使用的字符串，在本例中为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 组合它们
• 使用as.character(as.tags(l)) 转换为DT 内的可用字符串

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