问题
Is it possible to add a custom label to a sparkline plot?
For example, in the code below, I would like to label each bar with the corresponding letter in the label column.
Building from a previous [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)
回答1:
Ok, so we start by getting the sparklines in the datatable. This Github issue might be helpful and offers what I think is a better approach than the original and popular Combining data tables and sparklines post.
Add sparkline in datatable
I will comment #### inline to explain the changes.
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)
Add the Labelled Tooltip
We'll make a little helper function borrowing lessons from 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)
)
)
}
Altogether
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:
Given that
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
adding a printed label over each bar is not a functionality of sparklines.
However, you are able to change the mouseover of the bar to your desired labels (e.g. "C", "D", and "E") and the color of each bar. I've taken the liberty of also making the bar charts larger/wider so that the mouseover option is more user-intuitive.
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)
来源：https://stackoverflow.com/questions/45179410/add-label-to-sparkline-plot-in-datatable