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

鉴于此

常见问题

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

迷你图旨在小到足以与一条线相配   文本，给出趋势或模式的快速印象，因此不会   有全尺寸图表的随身物品。从版本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)

Answer 2

好的，我们首先得到数据表中的迷你图。这个Github issue可能会有所帮助，并提供我认为比原始Combining data tables and sparklines帖子更好的方法。

在数据表中添加迷你图

我会在内联评论####来解释这些变化。

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)

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

2 个答案:

在数据表中添加迷你图

添加标签工具提示

共