使用DT和Shiny在R中合成Sparkline

Question

我有一个leonawicz 的参考,可以完美地结合迷你线和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使用这些函数以更多方式轻松地再现所有JS代码所取得的成就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转换为可在另一个窗口小部件中使用的字符串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()