将标签添加到数据表中的迷你图

Question

是否可以向迷你图添加自定义标签？

例如，在下面的代码中，我想在标签列中用对应的字母标记每个条。

从以前的 [answer] 构建

require(sparkline)
require(DT)
require(shiny)
require(tibble)

# create data


spark_data1<-tribble(
  ~id,  ~label,~spark,
  "a", c("C,D,E"),c("1,2,3"),
  "b", c("C,D,E"),c("3,2,1")
)

ui <- fluidPage(
  sparklineOutput("test_spark"),
  DT::dataTableOutput("tbl")
)

server <- function(input, output) {

  output$tbl <- DT::renderDataTable({
    line_string <- "type: 'bar'"
    cd <- list(list(targets = 2, render = JS("function(data, type, full){ return '<span class=sparkSamples>' + data + '</span>' }")))
    cb = JS(paste0("function (oSettings, json) {\n  $('.sparkSamples:not(:has(canvas))').sparkline('html', { ", 
                   line_string, " });\n}"), collapse = "")
    dt <-  DT::datatable(as.data.frame(spark_data1),  rownames = FALSE, options = list(columnDefs = cd,fnDrawCallback = cb))

  })

}

shinyApp(ui = ui, server = server)

Answer 1

好的，我们从获取数据表中的迷你图开始。这个Github issue 可能会有所帮助，并且提供了我认为比原始和流行的Combining data tables and sparklines 帖子更好的方法。

在数据表中添加迷你图

我将评论#### inline 以解释更改。

require(sparkline)
require(DT)
require(shiny)
require(tibble)

# create data

spark_data1<-tribble(
  ~id,  ~label,~spark,
#### use sparkline::spk_chr helper
####   note spk_chr build for easy usage with dplyr, summarize
  "a", c("C,D,E"),spk_chr(1:3,type="bar"),
  "b", c("C,D,E"),spk_chr(3:1,type="bar")
)

ui <- tagList(
  fluidPage(
    DT::dataTableOutput("tbl")
  ),
#### add dependencies for sparkline in advance
#### since we know we are using
  htmlwidgets::getDependency("sparkline", "sparkline")
) 

server <- function(input, output) {

  output$tbl <- DT::renderDataTable({
    cb <- htmlwidgets::JS('function(){debugger;HTMLWidgets.staticRender();}')

    dt <-  DT::datatable(
      as.data.frame(spark_data1),
      rownames = FALSE,
      escape = FALSE,
      options = list(
#### add the drawCallback to static render the sparklines
####   staticRender will not redraw what has already been rendered
        drawCallback =  cb
      )
    )

  })

}

shinyApp(ui = ui, server = server)

添加标签工具提示

我们会借鉴Github issue的经验做一个小辅助函数。

#### helper function for adding the tooltip
spk_tool <- function(labels) {
  htmlwidgets::JS(
    sprintf(
"function(sparkline, options, field){
  return %s[field[0].offset];
}",
    jsonlite::toJSON(labels)
    )
  )
}

一共

live example

require(sparkline)
require(DT)
require(shiny)
require(tibble)

#### helper function for adding the tooltip
spk_tool <- function(labels) {
  htmlwidgets::JS(
    sprintf(
"function(sparkline, options, field){
  return %s[field[0].offset];
}",
    jsonlite::toJSON(labels)
    )
  )
}

# create data
spark_data1<-tribble(
  ~id,  ~spark,
#### use sparkline::spk_chr helper
####   note spk_chr build for easy usage with dplyr, summarize
  "a", spk_chr(1:3,type="bar", tooltipFormatter=spk_tool(c("C","D","E"))),
  "b", spk_chr(3:1,type="bar",tooltipFormatter=spk_tool(c("C","D","E")))
)

ui <- tagList(
  fluidPage(
    DT::dataTableOutput("tbl")
  ),
#### add dependencies for sparkline in advance
#### since we know we are using
  htmlwidgets::getDependency("sparkline", "sparkline")
) 

server <- function(input, output) {

  output$tbl <- DT::renderDataTable({
    cb <- htmlwidgets::JS('function(){debugger;HTMLWidgets.staticRender();}')

    dt <-  DT::datatable(
      as.data.frame(spark_data1),
      rownames = FALSE,
      escape = FALSE,
      options = list(
#### add the drawCallback to static render the sparklines
####   staticRender will not redraw what has already been rendered
        drawCallback =  cb
      )
    )

  })

}

shinyApp(ui = ui, server = server)

Answer 2

考虑到

常见问题

为什么没有轴标签/标记？

迷你图的设计目的是要足够小，以便与一行 文本，以便快速了解趋势或模式，因此不要 拥有全尺寸图表的用具。从 2.0 版开始，您可以 将鼠标悬停在迷你图上以查看基础数据。

来自sparkline FAQ

在每个条形图上添加打印标签不是迷你图的功能。

但是，您可以将鼠标悬停在栏上更改为所需的标签（例如“C”、“D”和“E”）以及每个栏的颜色。我还冒昧地使条形图更大/更宽，以便鼠标悬停选项更直观。

require(sparkline)
require(DT)
require(shiny)

# create data


spark_data1<-tribble(
        ~id,  ~label,~spark,
        "a", c("C,D,E"),c("1,2,3"),
        "b", c("C,D,E"),c("3,2,1")
)

ui <- fluidPage(
        sparklineOutput("test_spark"),
        DT::dataTableOutput("tbl")
)

server <- function(input, output) {

    output$tbl <- DT::renderDataTable({
                line_string <- "type: 'bar', 
                                height:'50', width:'200', barWidth:'20', 
                            tooltipFormat: '{{offset:offset}}',
                            tooltipValueLookups: {
                                'offset': {
                                    0: 'C',
                                    1: 'D',
                                    2: 'E',
                                }
                            },
                            colorMap: ['red','blue','yellow']"
                cd <- list(list(targets = 2, render = JS("function(data, type, full){ return '<span class=sparkSamples>' + data + '</span>' }")))
                cb = JS(paste0("function (oSettings, json) {\n  $('.sparkSamples:not(:has(canvas))').sparkline('html', { ", 
                                line_string, " });\n}"), collapse = "")
                dt <-  DT::datatable(as.data.frame(spark_data1),  rownames = FALSE, options = list(columnDefs = cd,fnDrawCallback = cb))

            })

}

shinyApp(ui = ui, server = server)