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

Question

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

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

从以前的

构建

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

鉴于

Frequently Asked Questions

Why are there no axis labels/markers?

Sparklines are intended to be small enough to fit alongside a line of text, to give a quick impression of a trend or pattern and thus don't have the paraphernalia of full sized charts. As of version 2.0 you can mouse over the sparklines to see the underlying data.

From sparkline FAQ

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

但是，您可以将栏的鼠标悬停更改为所需的标签（例如 "C"、"D" 和 "E"）以及每个栏的颜色。我冒昧地制作了条形图 larger/wider 以便鼠标悬停选项更直观。

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)

Answer 2

好的，所以我们从获取数据表中的迷你图开始。这个Github issue might be helpful and offers what I think is a better approach than the original and popular Combining data tables and sparklinespost.

在数据表中添加迷你图

我会在评论 #### 内联解释更改。

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)

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

Add label to sparkline plot in datatable

r

sparklines

shiny

dt

在数据表中添加迷你图

添加带标签的工具提示

一共