I found a way to do it by changing the underlying function react_sparkline. At the end of the post I show the full function mySparkline and highlight in the comments which part I added.
Now two new options are possible:
First, we can add a vector of length > 1 containing the maximum value for each data set:
# (A) we can now use a vector of length > 1 in max_value
# works
reactable(mydat,
columns = list(
data = colDef(
cell = mySparkline(
mydat,
height = 80,
show_area = TRUE,
max_value = c(50,100,50),
tooltip_type = 2
)
)
)
)
Second, we can use a function instead which is applied to the maximum value of each data set:
# (B) we can now use a function in max_value which will be applied to the maximum value of each
# data set
# works
reactable(mydat,
columns = list(
data = colDef(
cell = mySparkline(
mydat,
height = 80,
show_area = TRUE,
max_value = function(x) ceiling(x/50)*50,
tooltip_type = 2
)
)
)
)
Below is the new function mySparkline. Look for the comments saying ## new code.
mySparkline <- function (data, height = 22, show_line = TRUE, line_color = "slategray",
line_color_ref = NULL, line_width = 1, line_curve = "cardinal",
highlight_points = NULL, point_size = 1.1, labels = "none",
label_size = "0.8em", decimals = 0, min_value = NULL, max_value = NULL,
show_area = FALSE, area_color = NULL, area_color_ref = NULL,
area_opacity = 0.1, statline = NULL, statline_color = "red",
statline_label_size = "0.8em", bandline = NULL, bandline_color = "red",
bandline_opacity = 0.2, tooltip = TRUE, tooltip_type = 1,
tooltip_color = NULL, tooltip_size = "1.1em", margin = NULL) {
cell <- function(value, index, name) {
if (!requireNamespace("dataui", quietly = TRUE)) {
stop("The `dataui` package is required to use `react_sparkline()`.",
call. = FALSE)
}
else {
if (!is.null(margin) && length(margin) < 4) {
stop("please provide margin dimensions within `margin()`. Ex. margin = margin(t=10)")
}
if (!is.null(highlight_points) && length(highlight_points) <
5) {
stop("please provide point color assignments within `highlight_points()`. Ex. highlight_points = highlight_points(max='red')")
}
if (is.null(highlight_points)) {
highlight_points <- highlight_points(all = "transparent",
first = "transparent", last = "transparent",
min = "transparent", max = "transparent")
}
else {
highlight_points <- highlight_points
}
if (!is.logical(show_line)) {
stop("`show_line` must either be TRUE or FALSE.")
}
if (!is.logical(tooltip)) {
stop("`tooltip` must either be TRUE or FALSE.")
}
if (!is.null(tooltip_type) && !any(tooltip_type %in%
c(1, 2))) {
stop("`tooltip_type` must be either 1 or 2")
}
if (!is.logical(show_area)) {
stop("`show_area` must either be TRUE or FALSE.")
}
if (!is.null(labels) && !any(labels %in% c("none",
"first", "last", "min", "max", "all"))) {
stop("`labels` must be either first, last, min, max, all, or none")
}
if (!is.null(line_curve) && !any(line_curve %in%
c("cardinal", "linear", "basis", "monotoneX"))) {
stop("`line_curve` must be either cardinal, linear, basis, or monotoneX")
}
if (!is.null(bandline) && !any(bandline %in% c("innerquartiles",
"range"))) {
stop("`bandline` must be either innerquartiles or range")
}
if (!is.null(statline) && !any(statline %in% c("mean",
"median", "min", "max"))) {
stop("`statline` must be either mean, median, min, or max")
}
last_index <- lapply(data[[name]], function(x) length(x) -
1)
value_max <- lapply(data[[name]], function(x) x[which.max(abs(x))])
value_min <- lapply(data[[name]], function(x) x[which.min(abs(x))])
value_mean <- lapply(data[[name]], mean)
## new code added from here ##
### make max_value work with vectors of length > 1 and functions
if(is.function(max_value)) {
max_value <- lapply(value_max, max_value)
}
if (length(max_value) > 1) {
if (length(max_value) != length(value_max)) {
stop(paste0("`max_value` must either be a numeric vector of length 1, ",
"a numeric vector of length equal to the number of rows or a function."))
}
max_value <- max_value[[index]]
}
## new code up to here ##
if (!is.null(statline) && statline %in% c("mean",
"median", "min", "max")) {
statline <- dataui::dui_sparkhorizontalrefline(stroke = statline_color,
strokeDasharray = "2, 2", strokeWidth = 1,
strokeOpacity = 0.75, reference = statline,
renderLabel = htmlwidgets::JS(htmltools::HTML(paste0("(d) => React.createElement('tspan', {fill: '",
statline_color, "', fontWeight: 'bold', fontSize: '",
statline_label_size, "', stroke: 'transparent'}, d.toFixed(",
decimals, "))"))), labelPosition = "right",
labelOffset = 5)
if (any(labels %in% "none") && is.null(margin)) {
margin <- margin(t = 4, r = 28, b = 3, l = 13)
}
else if (any(labels %in% c("first", "last")) &&
(!any(stringr::str_detect(labels, "min")) &&
!any(stringr::str_detect(labels, "max")) &&
!any(stringr::str_detect(labels, "all"))) &&
is.null(margin)) {
margin <- margin(t = 5, r = 28, b = 3, l = 24)
}
else if (is.null(margin)) {
margin <- margin(t = 14, r = 28, b = 10, l = 13)
if (height == 22) {
height <- 28
}
else {
height <- height
}
}
}
else {
statline <- dataui::dui_sparkhorizontalrefline(stroke = "transparent")
}
if (any(labels %in% "none") && is.null(margin)) {
margin <- margin(t = 3, r = 13, b = 2, l = 13)
}
else if (any(labels %in% c("first", "last")) &&
(!any(stringr::str_detect(labels, "min")) &&
!any(stringr::str_detect(labels, "max")) &&
!any(stringr::str_detect(labels, "all"))) &&
is.null(margin)) {
margin <- margin(t = 5, r = 24, b = 3, l = 24)
}
else if (is.null(margin)) {
margin <- margin(t = 14, r = 13, b = 10, l = 13)
if (height == 22) {
height <- 30
}
else {
height <- height
}
}
if (any(labels %in% c("first", "last")) && (!any(stringr::str_detect(labels,
"max")) && !any(stringr::str_detect(labels,
"min")) && !any(stringr::str_detect(labels,
"all")))) {
label_position <- htmlwidgets::JS(paste0("{(d, i) => ((i === 0) ? 'left'\n : (i === ",
last_index[index], ") ? 'right'\n : 'top')}"))
label_offset <- 6
}
else {
label_position <- "auto"
label_offset <- 7
}
if (!is.null(bandline) && bandline == "innerquartiles") {
bandline_pattern <- dataui::dui_sparkpatternlines(id = "pattern",
height = 4, width = 4, stroke = bandline_color,
strokeWidth = 1, orientation = list("diagonal"))
bandline <- dataui::dui_sparkbandline(band = "innerquartiles",
fill = "url(#pattern)", fillOpacity = bandline_opacity)
}
else if (!is.null(bandline) && bandline == "range") {
bandline_pattern <- dataui::dui_sparkpatternlines(id = "pattern",
height = 4, width = 4, stroke = bandline_color,
strokeWidth = 1, orientation = list("diagonal"))
bandline <- dataui::dui_sparkbandline(band = list(from = list(y = min(value)),
to = list(y = max(value))), fill = "url(#pattern)",
fillOpacity = bandline_opacity)
}
else {
bandline_pattern <- dataui::dui_sparkpatternlines(id = "NA",
stroke = "transparent")
bandline <- dataui::dui_sparkbandline(fill = "transparent")
}
if (!is.null(line_color_ref) && is.character(line_color_ref)) {
if (all(line_color_ref %in% names(which(sapply(data,
is.character))))) {
if (is.character(line_color_ref)) {
line_color_ref <- which(names(data) %in%
line_color_ref)
}
line_color <- data[[line_color_ref]][index]
}
else {
stop("Attempted to select non-existing column or non-character column with line_color_ref")
}
}
if (is.null(line_color_ref)) {
line_color <- line_color
}
if (is.null(area_color)) {
area_color <- line_color
}
else {
area_color <- area_color
}
if (!is.null(area_color_ref) && is.character(area_color_ref)) {
if (all(area_color_ref %in% names(which(sapply(data,
is.character))))) {
if (is.character(area_color_ref)) {
area_color_ref <- which(names(data) %in%
area_color_ref)
}
area_color <- data[[area_color_ref]][index]
}
else {
stop("Attempted to select non-existing column or non-character column with area_color_ref")
}
}
if (is.null(area_color_ref)) {
area_color <- area_color
}
tooltip_position <- htmlwidgets::JS(paste0("{(yVal, i) => ((yVal > ",
value_mean[index], ") ? 'bottom'\n : 'top')}"))
tooltip_offset <- 5
if (is.null(tooltip_color)) {
tooltip_color <- line_color
}
else {
tooltip_color <- tooltip_color
}
if (tooltip == TRUE) {
if (tooltip_type == 1) {
tooltip_1 <- dataui::dui_tooltip(components = list(dataui::dui_sparkpointseries(size = 0,
renderLabel = htmlwidgets::JS(htmltools::HTML(paste0("(d) => React.createElement('tspan', {fill: '",
tooltip_color, "', fontSize: '", tooltip_size,
"', fontWeight: 'bold', stroke: 'white'}, d.toFixed(",
decimals, "))"))), labelPosition = tooltip_position,
labelOffset = tooltip_offset)))
tooltip_2 <- NULL
}
else {
tooltip_1 <- dataui::dui_tooltip(components = list(dataui::dui_sparkpointseries(size = 0)))
tooltip_2 <- htmlwidgets::JS(htmltools::HTML(paste0("\n function (_ref) {\n var datum = _ref.datum;\n return React.createElement(\n 'tspan',\n {style: {fontSize: '",
tooltip_size, "', color: '", tooltip_color,
"', fontWeight: 'bold', stroke: 'transparent'}},\n datum.y ? datum.y.toLocaleString(undefined, {maximumFractionDigits: ",
decimals, "}) : \"--\"\n )\n }\n ")))
}
}
else {
tooltip_1 <- dataui::dui_tooltip(components = list(dataui::dui_sparkpointseries(size = 0)))
tooltip_2 <- NULL
}
dataui::dui_sparkline(data = value, height = height,
max = max_value, min = min_value, margin = list(top = margin[[1]],
right = margin[[2]], bottom = margin[[3]],
left = margin[[4]]), renderTooltip = tooltip_2,
components = list(dataui::dui_sparklineseries(curve = line_curve,
showLine = show_line, stroke = line_color,
strokeWidth = line_width, fill = area_color,
fillOpacity = area_opacity, showArea = show_area),
dataui::dui_sparkpointseries(points = as.list("all"),
stroke = highlight_points[[1]], fill = highlight_points[[1]],
size = point_size), dataui::dui_sparkpointseries(points = as.list("first"),
stroke = highlight_points[[2]], fill = highlight_points[[2]],
size = point_size), dataui::dui_sparkpointseries(points = as.list("last"),
stroke = highlight_points[[3]], fill = highlight_points[[3]],
size = point_size), dataui::dui_sparkpointseries(points = as.list("min"),
stroke = highlight_points[[4]], fill = highlight_points[[4]],
size = point_size), dataui::dui_sparkpointseries(points = as.list("max"),
stroke = highlight_points[[5]], fill = highlight_points[[5]],
size = point_size), dataui::dui_sparkpointseries(points = as.list(labels),
fill = "transparent", stroke = "transparent",
renderLabel = htmlwidgets::JS(htmltools::HTML(paste0("(d) => React.createElement('tspan', {fill: '",
line_color, "', fontSize: '", label_size,
"', stroke: 'transparent'}, d.toFixed(",
decimals, "))"))), labelPosition = label_position,
labelOffset = label_offset), statline, bandline_pattern,
bandline, tooltip_1))
}
}
}
