#' Bar
#'
#' Bar Chart
#' @inherit Column
#' @param y.tick.label.wrap Logical; whether to wrap long labels on the y-axis (vertical).
#' @param y.tick.label.wrap.nchar Integer; number of characters in each line when \code{y.tick.label.wrap} is \code{TRUE}.
#' @param x.tick.suffix x-axis tick label suffix
#' @param x.tick.prefix x-axis tick label prefix
#' @param pyramid Logical; show bar chart as a pyramid. Usually called internally
#' @importFrom grDevices rgb
#' @importFrom flipChartBasics ChartColors
#' @importFrom plotly plot_ly config toRGB add_trace add_text layout hide_colorbar
#' @importFrom stats loess loess.control lm predict
#' @examples
#' z <- structure(c(1L, 2L, 3L, 4L, 5L, 2L, 3L, 4L, 5L, 6L), .Dim = c(5L, 2L),
#' .Dimnames = list(c("T", "U", "V", "W", "X"), c("A", "B")))
#' Bar(z, type="100% Stacked Bar")
#' @export
Bar <- function(x,
type = "Bar",
pyramid = FALSE,
annotation.list = NULL,
colors = ChartColors(max(1, ncol(x), na.rm = TRUE)),
multi.colors.within.series = FALSE,
opacity = NULL,
fit.type = "None", # can be "Smooth" or anything else
fit.window.size = 2,
fit.line.colors = colors,
fit.ignore.last = FALSE,
fit.line.type = "dot",
fit.line.width = 1,
fit.line.name = "Fitted",
fit.line.opacity = 1,
fit.CI.show = FALSE,
fit.CI.colors = fit.line.colors,
fit.CI.opacity = 0.4,
global.font.family = "Arial",
global.font.color = rgb(44, 44, 44, maxColorValue = 255),
title = "",
title.font.family = global.font.family,
title.font.color = global.font.color,
title.font.size = 16,
title.align = "center",
subtitle = "",
subtitle.font.family = global.font.family,
subtitle.font.color = global.font.color,
subtitle.font.size = 12,
subtitle.align = "center",
footer = "",
footer.font.family = global.font.family,
footer.font.color = global.font.color,
footer.font.size = 8,
footer.align = "center",
footer.wrap = TRUE,
footer.wrap.nchar = 100,
background.fill.color = "transparent",
background.fill.opacity = 1,
charting.area.fill.color = background.fill.color,
charting.area.fill.opacity = 0,
legend.show = NA,
legend.orientation = "Vertical",
legend.wrap = TRUE,
legend.wrap.nchar = 30,
legend.position.x = NULL,
legend.position.y = NULL,
legend.ascending = NA,
legend.fill.color = background.fill.color,
legend.fill.opacity = 0,
legend.border.color = rgb(44, 44, 44, maxColorValue = 255),
legend.border.line.width = 0,
legend.font.color = global.font.color,
legend.font.family = global.font.family,
legend.font.size = 10,
margin.autoexpand = TRUE,
margin.top = NULL,
margin.bottom = NULL,
margin.left = NULL,
margin.right = NULL,
margin.inner.pad = NULL,
grid.show = TRUE,
y.title = "",
y.title.font.color = global.font.color,
y.title.font.family = global.font.family,
y.title.font.size = 12,
y.line.width = 0,
y.line.color = rgb(0, 0, 0, maxColorValue = 255),
y.tick.mark.length = 3,
y.tick.mark.color = "transparent",
y.bounds.minimum = NULL,
y.bounds.maximum = NULL,
y.tick.distance = NULL,
y.tick.maxnum = 11,
y.zero = FALSE,
y.zero.line.width = 0,
y.zero.line.color = rgb(225, 225, 225, maxColorValue = 255),
y.data.reversed = FALSE,
y.grid.width = 0 * grid.show,
y.grid.color = rgb(225, 225, 225, maxColorValue = 255),
y.tick.show = TRUE,
y.tick.suffix = "",
y.tick.prefix = "",
y.tick.format= "",
y.hovertext.format= y.tick.format,
y.tick.angle = NULL,
y.tick.font.color = global.font.color,
y.tick.font.family = global.font.family,
y.tick.font.size = 10,
x.title = "",
x.title.font.color = global.font.color,
x.title.font.family = global.font.family,
x.title.font.size = 12,
x.line.width = 0,
x.line.color = rgb(0, 0, 0, maxColorValue = 255),
x.tick.marks = "",
x.tick.mark.length = 0,
x.tick.mark.color = "transparent",
x.bounds.minimum = NULL,
x.bounds.maximum = NULL,
x.tick.distance = NULL,
x.tick.maxnum = NULL,
x.zero = TRUE,
x.zero.line.width = 0,
x.zero.line.color = rgb(225, 225, 225, maxColorValue = 255),
x.data.reversed = FALSE,
x.grid.width = 1 * grid.show,
x.grid.color = rgb(225, 225, 225, maxColorValue = 255),
x.tick.show = TRUE,
x.tick.suffix = "",
x.tick.prefix = "",
x.tick.format = "",
x.hovertext.format = x.tick.format,
x.tick.angle = NULL,
x.tick.font.color = global.font.color,
x.tick.font.family = global.font.family,
x.tick.font.size = 10,
y.tick.label.wrap = TRUE,
y.tick.label.wrap.nchar = 21,
hovertext.font.family = global.font.family,
hovertext.font.size = 11,
hovertext.template = NULL,
hovertext.align = "left",
marker.border.width = 1,
marker.border.colors = NULL,
marker.border.opacity = opacity,
tooltip.show = TRUE,
modebar.show = FALSE,
zoom.enable = TRUE,
axis.drag.enable = FALSE,
bar.gap = 0.15,
bar.group.gap = 0.0,
data.label.show = FALSE,
data.label.font.autocolor = FALSE,
data.label.font.family = global.font.family,
data.label.font.size = 10,
data.label.font.color = global.font.color,
data.label.format = "",
data.label.prefix = "",
data.label.suffix = "",
data.label.threshold = NULL,
average.series = NULL,
average.color = rgb(230, 230, 230, maxColorValue = 255))
{
ErrorIfNotEnoughData(x)
if (isPercentData(x))
{
if (isAutoFormat(x.tick.format))
x.tick.format <- paste0(x.tick.format, "%")
if (isAutoFormat(x.hovertext.format))
x.hovertext.format <- paste0(x.hovertext.format, "%")
if (isAutoFormat(data.label.format))
data.label.format <- paste0(data.label.format, "%")
sfx <- checkSuffixForExtraPercent(c(x.tick.suffix, data.label.suffix),
c(x.tick.format, data.label.format))
x.tick.suffix <- sfx[1]
data.label.suffix <- sfx[2]
}
# Store data for chart annotations
annot.data <- x
chart.matrix <- checkMatrixNames(x)
if (!is.numeric(chart.matrix))
stop("Input data should be numeric.")
if (multi.colors.within.series && NCOL(chart.matrix) > 1)
{
warning("Bar chart with multi color series can only show a single series. To show multiple series use Small Multiples")
chart.matrix <- chart.matrix[,1, drop = FALSE]
}
x.labels.full <- rownames(chart.matrix)
is.stacked <- grepl("Stacked", type, fixed=T)
if (is.stacked && ncol(chart.matrix) < 2)
{
warning("To perform stacking on a single series select \"Switch rows and columns\" under Inputs > DATA MANIPULATION below")
is.stacked <- FALSE
}
is.hundred.percent.stacked <- grepl("100% Stacked", type, fixed=T)
if (any(!is.finite(as.matrix(chart.matrix))))
warning("Missing values have been set to zero.")
if (type == "Stacked")
type <- "Stacked Bar"
if (type == "100% Stacked")
type <- "100% Stacked Bar"
if (!is.stacked)
type <- "Bar"
if (bar.gap < 0.0 || bar.gap >= 1.0)
{
warning("Parameter 'bar gap' must be between 0 and 1. ",
"Invalid 'bar gap' set to default value of 0.15.")
bar.gap <- 0.15
}
if (is.stacked || ncol(chart.matrix) < 2)
bar.group.gap <- 0.0
if (bar.group.gap < 0.0 || bar.group.gap >= 1.0)
{
warning("Parameter 'bar group gap' must be between 0 and 1. ",
"Invalid 'bar group gap' set to default value of 0.0.")
bar.group.gap <- 0.0
}
# Some minimal data cleaning
# Assume formatting and Qtable/attribute handling already done
data.label.mult <- 1
if (is.hundred.percent.stacked)
chart.matrix <- cum.data(chart.matrix, "column.percentage")
if (percentFromD3(data.label.format)) {
data.label.suffix <- paste0("%", data.label.suffix)
data.label.mult <- 100
}
data.label.decimals <- decimalsFromD3(data.label.format)
data.label.prefix <- vectorize(data.label.prefix, ncol(chart.matrix), nrow(chart.matrix), split = NULL)
data.label.suffix <- vectorize(data.label.suffix, ncol(chart.matrix), nrow(chart.matrix), split = NULL)
matrix.labels <- names(dimnames(chart.matrix))
if (nchar(y.title) == 0 && length(matrix.labels) == 2)
y.title <- matrix.labels[1]
# Constants
barmode <- "group"
if (is.stacked)
barmode <- "relative"
else if (pyramid)
barmode <- "overlay"
if (is.null(opacity))
opacity <- if (fit.type == "None") 1 else 0.6
if (is.null(marker.border.opacity))
marker.border.opacity <- opacity
if (!is.null(marker.border.colors))
marker.border.colors <- vectorize(marker.border.colors, ncol(chart.matrix))
colors <- if (multi.colors.within.series) vectorize(colors, nrow(chart.matrix))
else vectorize(colors, ncol(chart.matrix))
data.label.font.color <- if (multi.colors.within.series) vectorize(data.label.font.color, nrow(chart.matrix))
else vectorize(data.label.font.color, ncol(chart.matrix))
data.label.show <- vectorize(data.label.show, NCOL(chart.matrix), NROW(chart.matrix))
title.font = list(family = title.font.family, size = title.font.size, color = title.font.color)
subtitle.font = list(family = subtitle.font.family, size = subtitle.font.size, color = subtitle.font.color)
x.title.font = list(family = x.title.font.family, size = x.title.font.size, color = x.title.font.color)
y.title.font = list(family = y.title.font.family, size = y.title.font.size, color = y.title.font.color)
ytick.font = list(family = y.tick.font.family, size = y.tick.font.size, color = y.tick.font.color)
xtick.font = list(family = x.tick.font.family, size = x.tick.font.size, color = x.tick.font.color)
footer.font = list(family = footer.font.family, size = footer.font.size, color = footer.font.color)
legend.font = list(family = legend.font.family, size = legend.font.size, color = legend.font.color)
legend.show <- setShowLegend(legend.show, NCOL(chart.matrix))
legend <- setLegend(type, legend.font, legend.ascending, legend.fill.color, legend.fill.opacity,
legend.border.color, legend.border.line.width, legend.position.x, legend.position.y,
FALSE, legend.orientation)
footer <- autoFormatLongLabels(footer, footer.wrap, footer.wrap.nchar, truncate = FALSE)
# Format axis labels
if (is.null(x.bounds.maximum) || is.na(x.bounds.maximum) || x.bounds.maximum == "")
x.bounds.maximum <- NULL
if (pyramid)
{
x.bounds.minimum <- if (!is.null(x.bounds.maximum)) -1 * charToNumeric(x.bounds.maximum)
else NULL
}
axisFormat <- formatLabels(chart.matrix, type, y.tick.label.wrap, y.tick.label.wrap.nchar,
y.tick.format, x.tick.format)
x.range <- setValRange(x.bounds.minimum, x.bounds.maximum, chart.matrix, x.zero, is.null(x.tick.distance))
y.range <- setValRange(y.bounds.minimum, y.bounds.maximum, axisFormat, y.zero, is.null(y.tick.distance), is.bar = TRUE)
tmp.label <- sprintf(paste0("%s%.", data.label.decimals, "f%s"),
data.label.prefix, max(chart.matrix), data.label.suffix)
xtick <- setTicks(x.range$min, x.range$max, x.tick.distance, x.data.reversed, type = type,
data = if (any(data.label.show) && !is.stacked && !pyramid && is.null(x.range$max)) chart.matrix else NULL,
labels = tmp.label, label.font.size = data.label.font.size)
ytick <- setTicks(y.range$min, y.range$max, y.tick.distance, !y.data.reversed, is.bar = TRUE)
yaxis <- setAxis(y.title, "left", axisFormat, y.title.font,
y.line.color, y.line.width, y.grid.width * grid.show, y.grid.color,
ytick, ytick.font, y.tick.angle, y.tick.mark.length, y.tick.distance,
y.tick.format, y.tick.prefix, y.tick.suffix, y.tick.show,
y.zero, y.zero.line.width, y.zero.line.color,
y.hovertext.format, with.bars = TRUE, num.maxticks = y.tick.maxnum,
tickcolor = y.tick.mark.color, zoom.enable = zoom.enable)
if (yaxis$type == "category")
yaxis$nticks = NROW(chart.matrix)
xaxis <- setAxis(x.title, "bottom", axisFormat, x.title.font,
x.line.color, x.line.width, x.grid.width * grid.show, x.grid.color,
xtick, xtick.font, x.tick.angle, x.tick.mark.length, x.tick.distance,
x.tick.format, x.tick.prefix, x.tick.suffix, x.tick.show,
x.zero, x.zero.line.width, x.zero.line.color,
x.hovertext.format, num.maxticks = x.tick.maxnum,
tickcolor = x.tick.mark.color, zoom.enable = zoom.enable)
# Work out margin spacing
margins <- list(t = 20, b = 20, r = 60, l = 80, pad = 0)
margins <- setMarginsForAxis(margins, axisFormat, yaxis)
margins <- setMarginsForAxis(margins, as.character(range(x)), xaxis)
margins <- setMarginsForText(margins, title, subtitle, footer, title.font.size,
subtitle.font.size, footer.font.size)
legend.text <- autoFormatLongLabels(colnames(chart.matrix), legend.wrap, legend.wrap.nchar)
if (!legend.show)
legend.text[1] <- ""
margins <- setMarginsForLegend(margins, legend.show, legend, legend.text)
margins <- setCustomMargins(margins, margin.top, margin.bottom, margin.left,
margin.right, margin.inner.pad)
margins$autoexpand <- margin.autoexpand
# Set up numeric x-axis - this is used for data labels and hovertext
y.range <- getRange(x, yaxis, axisFormat)
yaxis2 <- list(overlaying = "y", visible = FALSE, range = y.range,
rangemode = "match", match = "y", fixedrange = !zoom.enable)
data.annotations <- dataLabelPositions(chart.matrix = chart.matrix,
axis.type = yaxis$type,
annotations = NULL,
data.label.mult = data.label.mult,
bar.decimals = data.label.decimals,
bar.prefix = data.label.prefix,
bar.suffix = data.label.suffix,
barmode = barmode,
swap.axes.and.data = TRUE,
bar.gap = bar.gap,
display.threshold = data.label.threshold,
dates = axisFormat$ymd,
font = NULL)
## Initiate plotly object
p <- plot_ly(as.data.frame(chart.matrix))
if (is.null(rownames(chart.matrix)))
rownames(chart.matrix) <- 1:nrow(chart.matrix)
x.labels <- axisFormat$labels
y.labels <- colnames(chart.matrix)
chart.labels <- list(SeriesLabels = list())
## Add a trace for each col of data in the matrix
for (i in 1:ncol(chart.matrix))
{
x <- x.labels
y <- as.numeric(chart.matrix[, i])
y.filled <- ifelse(is.finite(y), y, 0)
# Evaluate hover template because otherwise scatterplot hover added at end will
# show incorrect values (note stacking is not an issue)
hover.template <- setHoverTemplate(i, yaxis, chart.matrix, hovertext.template, is.bar = TRUE)
hover.template <- evalHoverTemplate(hover.template, y, x.hovertext.format,
x.tick.prefix, x.tick.suffix, x, y.hovertext.format, y.tick.prefix, y.tick.suffix)
tmp.color <- if (multi.colors.within.series) colors else colors[i]
tmp.border.color <- if (length(marker.border.colors) >= i) marker.border.colors[i] else tmp.color
dlab.color <- if (multi.colors.within.series) data.label.font.color else data.label.font.color[i]
if (data.label.font.autocolor && (is.stacked || pyramid))
dlab.color <- autoFontColor(tmp.color)
tmp.data.label.font = list(family = data.label.font.family,
size = data.label.font.size, color = dlab.color)
hover.label <- list(bgcolor = tmp.color, font = list(color = autoFontColor(tmp.color),
size = hovertext.font.size, family = hovertext.font.family))
if (any(!is.finite(y)))
{
tmp.border.color <- vectorize(tmp.border.color, NROW(chart.matrix))
tmp.border.color[which(!is.finite(y))] <- "transparent"
}
marker <- list(color = toRGB(tmp.color, alpha = opacity),
line = list(color = toRGB(tmp.border.color,
alpha = marker.border.opacity),
width = marker.border.width))
# add invisible line to force all categorical labels to be shown
tmp.min <- if (any(is.finite(chart.matrix))) min(chart.matrix[is.finite(chart.matrix)])
else x.bounds.minimum
if (pyramid)
tmp.min <- 0
if (!is.stacked && i == 1)
{
p <- add_trace(p, x = rep(tmp.min, length(y)), y = x,
type = "scatter", mode = "lines",
hoverinfo = "skip", showlegend = FALSE, opacity = 0)
}
# this is the main trace for each data series
# need to use y.filled to avoid plotly bug affecting bar-width
if (pyramid)
p <- add_trace(p, x = 2 * y.filled, y = x, base = -y, type = "bar", orientation = "h",
marker = marker, hoverlabel = hover.label, hovertemplate = hover.template)
else
p <- add_trace(p, x = y.filled, y = x, type = "bar", orientation = "h",
marker = marker, name = legend.text[i],
hoverlabel = hover.label, hovertemplate = hover.template,
legendgroup = i, offsetgroup = i)
if (fit.type != "None" && is.stacked && i == 1)
warning("Line of best fit not shown for stacked charts.")
if (fit.type != "None" && !is.stacked)
{
tmp.fit.color <- if (length(fit.line.colors) >= i) fit.line.colors[i] else tmp.color[1]
tmp.fit <- fitSeries(x, y, fit.type, fit.ignore.last, yaxis$type, fit.CI.show, fit.window.size)
tmp.fname <- if (ncol(chart.matrix) == 1) fit.line.name
else sprintf("%s: %s", fit.line.name, y.labels[i])
p <- add_trace(p, x = tmp.fit$y, y = tmp.fit$x, type = 'scatter', mode = "lines",
name = tmp.fname, legendgroup = i, showlegend = FALSE,
hoverlabel = list(font = list(color = autoFontColor(tmp.fit.color),
size = hovertext.font.size, family = hovertext.font.family)),
line = list(dash = fit.line.type, width = fit.line.width,
color = tmp.fit.color, shape = 'spline'), opacity = fit.line.opacity)
if (fit.CI.show && !is.null(tmp.fit$lb))
{
tmp.CI.color <- if (length(fit.CI.colors) >= i) fit.CI.colors[i] else tmp.color[1]
p <- add_trace(p, y = tmp.fit$x, x = tmp.fit$lb, type = 'scatter',
mode = 'lines', name = "Lower bound of 95%CI",
hoverlabel = list(font = list(color = autoFontColor(tmp.CI.color),
size = hovertext.font.size, family = hovertext.font.family)),
showlegend = FALSE, legendgroup = i,
line=list(color=tmp.CI.color, width=0, shape='spline'))
p <- add_trace(p, y = tmp.fit$x, x = tmp.fit$ub, type = 'scatter',
mode = 'lines', name = "Upper bound of 95% CI",
hoverlabel = list(font = list(color = autoFontColor(tmp.CI.color),
size = hovertext.font.size, family = hovertext.font.family)),
fill = "tonextx",
fillcolor = toRGB(tmp.CI.color, alpha = fit.CI.opacity),
showlegend = FALSE, legendgroup = i,
line = list(color=tmp.CI.color, width=0, shape='spline'))
}
}
# Initialise attribute for PPT exporting - SeriesLabels cannot be NULL
chart.labels$SeriesLabels[[i]] <- list(
Font = setFontForPPT(tmp.data.label.font), ShowValue = any(data.label.show[,i]))
if (any(data.label.show))
{
# Initialise custom points if annotations are used
pt.segs <- NULL
ind.show <- which(data.label.show[,i])
data.label.text <- NULL
multi.color.labels <- multi.colors.within.series && length(unique(dlab.color)) > 1
if (length(ind.show) > 0)
{
tmp.suffix <- if (percentFromD3(data.label.format)) sub("%", "", data.label.suffix[,i])
else data.label.suffix[,i]
if (!is.null(annotation.list) || length(ind.show) < nrow(chart.matrix) || multi.color.labels ||
any(nzchar(data.label.prefix[,i])) || any(nzchar(data.label.suffix[,i])))
{
chart.labels$SeriesLabels[[i]]$ShowValue <- FALSE
pt.segs <- lapply((1:nrow(chart.matrix)),
function(ii) list(Index = ii-1, Segments = c(
if (nzchar(data.label.prefix[ii,i])) list(list(Text = data.label.prefix[ii,i])) else NULL,
list(list(Field="Value")),
if (nzchar(tmp.suffix[ii])) list(list(Text = tmp.suffix[ii])) else NULL)))
if (multi.color.labels)
{
for (ii in 1:nrow(chart.matrix))
{
for (j in 1:length(pt.segs[[ii]]$Segments))
pt.segs[[ii]]$Segments[[j]]$Font$color <- dlab.color[ii]
}
}
for (ii in setdiff(1:nrow(chart.matrix), ind.show))
pt.segs[[ii]]$Segments <- NULL
}
# Apply annotations
# Circle annotations are added to pt.segs but not to the data labels
data.label.text <- data.annotations$text[,i]
data.label.nchar <- nchar(data.label.text) # get length before adding html tags
attr(data.label.text, "customPoints") <- pt.segs
data.label.text <- applyAllAnnotationsToDataLabels(data.label.text, annotation.list,
annot.data, i, ind.show, "Bar", clean.pt.segs = TRUE)
pt.segs <- attr(data.label.text, "customPoints")
}
p <- addTraceForBarTypeDataLabelAnnotations(p, type = "Bar", legend.text[i],
data.label.xpos = if (pyramid) rep(0, NROW(chart.matrix)) else data.annotations$x[,i],
data.label.ypos = if (NCOL(chart.matrix) > 1) data.annotations$y[,i] else x,
data.label.show = data.label.show[,i],
data.label.text = data.label.text,
data.label.sign = getSign(data.annotations$x[,i], xaxis), data.label.nchar,
annotation.list, annot.data, i,
yaxis = if (NCOL(chart.matrix) > 1) "y2" else "y", xaxis = "x",
tmp.data.label.font, is.stacked, data.label.centered = pyramid)
if (!is.null(pt.segs))
{
if (isTRUE(attr(pt.segs, "SeriesShowValue")))
{
chart.labels$SeriesLabels[[i]]$ShowValue <- TRUE
attr(pt.segs, "SeriesShowValue") <- NULL
}
if (length(pt.segs) > 0)
chart.labels$SeriesLabels[[i]]$CustomPoints <- pt.segs
}
}
# Add scatter trace to ensure hover is always shown
# The hover in the main trace does not show if bars are too small
# or if covered by the data labels
# Changing layout.hovermode will make it more responsive but text is diagonal
ypos <- if (NCOL(chart.matrix) > 1) data.annotations$y[,i] else x
xpos <- chart.matrix[,i]
if (pyramid)
xpos <- rep(0, NROW(chart.matrix))
ind.finite <- which(is.finite(y))
if (length(ind.finite) > 0)
p <- addAnnotScatterTrace(p, xpos = xpos[ind.finite], ypos = ypos[ind.finite], name = legend.text[i],
text = "", marker = list(color = tmp.color, opacity = 0.0),
hovertemplate = hover.template[ind.finite], hoverlabel = hover.label, xaxis = "x",
yaxis = if (NCOL(chart.matrix) > 1) "y2" else "y",
stackgroup = if (is.stacked) "hover" else "",
orientation = "h", legendgroup = i)
}
# Only used for small multiples
if (!is.null(average.series))
p <- add_trace(p, y = x, x = average.series, name = "Average",
type = "scatter", mode = "lines", showlegend = FALSE,
hoverlabel = list(font = list(color = autoFontColor(average.color),
size = hovertext.font.size, family = hovertext.font.family)),
line = list(color = average.color))
annotations <- NULL
n <- length(annotations)
annotations[[n+1]] <- setFooter(footer, footer.font, margins, footer.align)
annotations[[n+2]] <- setSubtitle(subtitle, subtitle.font, margins, subtitle.align)
annotations[[n+3]] <- setTitle(title, title.font, margins, title.align)
annotations <- Filter(Negate(is.null), annotations)
serieslabels.num.changes <- vapply(chart.labels$SeriesLabels, function(s) isTRUE(s$ShowValue) + length(s$CustomPoints), numeric(1L))
if (sum(serieslabels.num.changes) == 0)
chart.labels <- NULL
p <- config(p, displayModeBar = modebar.show, showAxisDragHandles = axis.drag.enable)
p$sizingPolicy$browser$padding <- 0
p <- layout(p,
showlegend = legend.show,
legend = legend,
yaxis = yaxis,
yaxis2 = yaxis2,
xaxis = xaxis,
margin = margins,
plot_bgcolor = toRGB(charting.area.fill.color, alpha = charting.area.fill.opacity),
paper_bgcolor = toRGB(background.fill.color, alpha = background.fill.opacity),
hoverlabel = list(namelength = -1, bordercolor = "transparent",
font = list(size = hovertext.font.size, family = hovertext.font.family)),
hovermode = if (tooltip.show) "closest" else FALSE,
annotations = annotations,
shapes = zerolines(x.zero, x.zero.line.width, x.zero.line.color,
y.zero, y.zero.line.width, y.zero.line.color),
bargap = bar.gap, bargroupgap = bar.group.gap,
barmode = barmode
)
attr(p, "can-run-in-root-dom") <- TRUE
result <- list(htmlwidget = p)
class(result) <- "StandardChart"
attr(result, "ChartType") <- if (is.stacked) "Bar Stacked" else "Bar Clustered"
attr(result, "ChartLabels") <- chart.labels
result
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.