使用DT和Shiny在R中组合Sparkline

Question

使用DT和Shiny在R中组合Sparkline

6

我有一个由leonawicz提供的参考资料，可以完美地将sparkline和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组合成一个火花线图表？再次感谢！

- glenchen

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- GGamba · Accepted Answer

首先，你让自己变得很困难。你用所有那些 JS 代码实现的功能可以轻松地用更加 "R" 的方式来重现，使用 sparkline 函数（如果没有添加依赖项，你就根本没有使用 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()

组合迷你走势图

不过，将这两个迷你走势图结合起来比我想象的更加困难。解决方案相当简单，但是找到它需要一点时间。

我的做法是：

将数据集分成几组
为每组创建迷你走势图
使用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()