#' Plot data as a Streamgraph
#'
#' Create a Streamtraph, which is an area chart centered around the x-axis rather than on top of it.
#' @param x A \code{matrix}, with columns containing the dates or other numeric x-axis variable.
#' @param colors A vector of colors of the streams.
#' @param global.font.color Global font color as a named color in character format
#' (e.g. "black") or an a hex code.
#' @param global.font.family Font family of tick labels.
#' @param global.font.size Font size of tick labels in pixels.
#' @param hovertext.font.family Font family of hovertext.
#' @param hovertext.font.color Font color of hovertext as a string or hex code.
#' @param hovertext.font.size Font size of hovertext in pixels.
#' @param y.axis.show Logical; if FALSE, the y-axis is not shown.
#' @param y.tick.format A string representing a d3 formatting code for the y-axis.
#' See https://github.com/d3/d3/blob/master/API.md#number-formats-d3-format
#' @param y.number.ticks The total number of ticks on the y-axis.
#' @param x.tick.format A string representing a d3 formatting code for the x.axis.
#' See https://github.com/d3/d3/blob/master/API.md#number-formats-d3-format
#' @param x.tick.units "Automatic", "Number", "Day", "Month" or "Year".
#' @param x.tick.interval The frequency of ticks on the x-axis. Where the data crosses multiple years, re-starts at each year.
#' If this is zero, it is determined from the data.
#' @param margin.top Top margin (default should be fine, this allows for fine-tuning plot space)
#' @param margin.right Right margin (default should be fine, this allows for fine-tuning plot space)
#' @param margin.bottom Bottom margin (default should be fine, this allows for fine-tuning plot space)
#' @param margin.left Left margin (default should be fine, this allows for fine-tuning plot space)
#' @importFrom streamgraph streamgraph sg_fill_manual sg_axis_x sg_axis_y sg_colors
#' @importFrom flipTime AsDateTime
#' @importFrom flipU MakeUniqueNames
#' @importFrom verbs SumEachColumn
#' @importFrom janitor round_half_up
#' @importFrom stats median
#' @export
Stream <- function(x,
colors = c("#5C9AD3", "#ED7D31", "#A5A5A5", "#FFC000",
"#4473C5", "#70AD46", "#255F91", "#9E480D",
"#636365", "#987300", "#26408B", "#42682B"),
global.font.family = "Arial",
global.font.color = rgb(44, 44, 44, maxColorValue = 255),
global.font.size = 10,
y.axis.show = TRUE,
y.tick.format = "",
y.number.ticks = 5,
x.tick.format = "%d %b %y",
x.tick.units = "Automatic",
x.tick.interval = 1,
hovertext.font.color = global.font.color,
hovertext.font.family = global.font.family,
hovertext.font.size = 11,
margin.top = 20,
margin.left = 50,
margin.bottom = 30,
margin.right = 40)
{
if (isPercentData(x) && isAutoFormat(y.tick.format))
y.tick.format <- paste0(y.tick.format, "%")
if (!is.list(x) && (is.array(x) || is.numeric(x)))
x <- checkMatrixNames(x)
else if (is.data.frame(x))
x <- as.matrix(x)
else
stop("Stream graphs should have a tabular input (e.g., a matrix).")
if (!x.tick.units %in% c("Automatic", "Number", "Day", "Month", "Year"))
stop("x.tick.units must be one of 'Automatic', 'Number', 'Day', 'Month' or 'Year'.")
# streamgraph requires dates along the columns but for consistency with Time Series, Line, Google Trends etc
# CChart produces dates along the rows, hence we transpose
colnames(x) <- MakeUniqueNames(colnames(x))
x <- t(x)
colors = StripAlphaChannel(colors, "Alpha values for colors in Streamgraphs are ignored.")
if (nrow(x) == 1)
colors <- c(colors, colors) # fix streamgraph bug where one color single stream is ignored and produces black chart
ErrorIfNotEnoughData(x)
columns <- colnames(x)
x.axis.type <- getAxisType(columns, x.tick.format)
if (!x.axis.type %in% c("date", "numeric"))
stop("Stream requires the rownames of the input data (which form the x-axis) to be dates or numeric. ",
"Change 'Chart type' to 'Table' to see the input data.")
if (!is.numeric(x))
stop("Stream requires numeric data to be plotted along the y-axis. ",
"Change 'Chart type' to 'Table' to see the input data.")
if (x.tick.units == "Automatic" && x.axis.type != "date")
x.tick.units <- "Number"
if (x.tick.units == "Number")
{
if (x.tick.format == "")
x.tick.format = ".0f"
if (d3FormatType(x.tick.format) != "numeric" || x.axis.type != "numeric")
stop("x-axis tick format and units are incompatible.")
columns <- suppressWarnings(as.numeric(columns))
if (any(is.na((columns))))
columns <- 1:ncol(x)
# convert x.tick.interval to a number of ticks as required in sg_axis_x for numeric axes
if (x.tick.interval == 0)
x.tick.interval <- 5
else
{
r <- range(columns)
x.tick.interval <- (r[2] - r[1]) / (x.tick.interval)
}
}
else
{
if (x.tick.format == "")
x.tick.format = "%d %b %y"
if (d3FormatType(x.tick.format) != "date" || x.axis.type != "date")
stop("x-axis tick format and units are incompatible.")
columns <- AsDateTime(columns, on.parse.failure = "silent")
diffs <- as.numeric(diff(columns))
med.diff <- median(abs(diffs), na.rm = TRUE)
max.diff <- max(abs(diffs), na.rm = TRUE)
if (max.diff > 1.1 * med.diff)
warning("Dates are not spaced at regular intervals. Most of the dates have a difference of ",
med.diff, " but the maximum interval is ", max.diff, ".")
r <- range(columns)
day.range <- r[2] - r[1]
if (x.tick.units == "Automatic")
{
if (day.range < 90)
x.tick.units <- "Day"
else if (day.range < 367)
x.tick.units <- "Month"
else
x.tick.units <- "Year"
}
if (x.tick.interval == 0)
{
if (x.tick.units == "Day")
x.tick.interval <- day.range / 5
else if (x.tick.units == "Month")
x.tick.interval <- day.range / 30 / 5
else
x.tick.interval <- day.range / 365 / 5
}
x.tick.interval <- ceiling(x.tick.interval)
}
# Rounding off data to make hovertext legible, but should not affect y-values on the graph
data.magnitude <- floor(log10(min(SumEachColumn(x, remove.rows = NULL))))
x.round <- round(as.numeric(t(x)), max(0, 4 - data.magnitude))
df <- data.frame(value = x.round, date = columns, key = rep(rownames(x), rep(ncol(x), nrow(x))))
sg <- streamgraph(data = df,
key = "key",
value = "value",
date = "date",
offset = "silhouette",
interpolate = "cardinal",
interactive = TRUE,
scale = if(x.tick.units == "Number") "continuous" else "date",
top = margin.top,
right = margin.right,
left = margin.left,
bottom = margin.bottom)
sg <- sg_fill_manual(sg, values = colors)
if (!y.axis.show)
sg <- sg_axis_y(sg, 0)
else
sg <- sg_axis_y(sg, tick_count = y.number.ticks, tick_format = y.tick.format)
sg <- sg_axis_x(sg, tick_interval = x.tick.interval, tick_units = tolower(x.tick.units),
tick_format = x.tick.format)
sg <- sg_colors(sg, axis_color = global.font.color, tooltip_color = hovertext.font.color)
# Set font of hovertext and tick labels
js <- paste0("function(){
document.querySelector('text').style.font = '", hovertext.font.size, "px ",
hovertext.font.family, "';
document.querySelector('text').style.fill = '", hovertext.font.color, "';
var ticks = document.querySelectorAll('g .tick text');
for (var i = 0; i < ticks.length; i++) {
ticks[i].style.font = '", global.font.size, "px ", global.font.family, "';
ticks[i].style.fill = '", global.font.color, "';
}}")
sg <- onRender(sg, js)
# Override default of fixed size widget
sg$sizingPolicy$browser$fill <- TRUE
result <- list(htmlwidget = sg)
class(result) <- "StandardChart"
attr(result, "ChartType") <- "Area Stacked"
result
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.