add_annotation <- function(ax, type_annotation = c("xaxis", "yaxis", "points"), as_date = FALSE, position = "back", ...) { type_annotation <- match.arg(type_annotation) config <- dropNullsOrEmpty(list(...)) if (!is.null(config$label) && is.character(config$label)) { config$label <- list(text = config$label) } if (!is.null(config$marker) && is.numeric(config$marker)) { config$marker <- list(size = config$marker) } if (identical(type_annotation, "yaxis")) { len <- length(config$y) } else { len <- length(config$x) } config <- rapply( object = config, f = rep_len, length.out = len, how = "replace" ) extract <- function(el, index) { `[`(el, index) } annotations <- lapply( X = seq_len(len), FUN = function(i) { this <- rapply( object = config, f = extract, index = i, how = "list" ) if (isTRUE(as_date)) { if (!is.null(this$x)) this$x <- format_date(this$x) if (!is.null(this$x2)) this$x2 <- format_date(this$x2) } this } ) if (identical(type_annotation, "xaxis")) { if (!is.null(ax$x$ax_opts$annotations$xaxis)) { annotations <- c(annotations, ax$x$ax_opts$annotations$xaxis) ax$x$ax_opts$annotations$xaxis <- NULL } ax <- ax_annotations( ax = ax, position = position, xaxis = annotations ) } else if (identical(type_annotation, "yaxis")) { if (!is.null(ax$x$ax_opts$annotations$yaxis)) { annotations <- c(annotations, ax$x$ax_opts$annotations$yaxis) ax$x$ax_opts$annotations$yaxis <- NULL } ax <- ax_annotations( ax = ax, position = position, yaxis = annotations ) } else if (identical(type_annotation, "points")) { if (!is.null(ax$x$ax_opts$annotations$points)) { annotations <- c(annotations, ax$x$ax_opts$annotations$points) ax$x$ax_opts$annotations$points <- NULL } ax <- ax_annotations( ax = ax, position = position, points = annotations ) } return(ax) } #' Label for annotations #' #' @param text Text for the annotation label. #' @param borderColor Border color for the label. #' @param borderWidth Border width for the label. #' @param textAnchor The alignment of text relative to label's drawing position. #' @param position Available options: left or right. #' @param offsetX Sets the left offset for annotation label. #' @param offsetY Sets the top offset for annotation label. #' @param background Background Color for the annotation label. #' @param color ForeColor for the annotation label. #' @param fontSize FontSize for the annotation label. #' @param fontWeight Font-weight for the annotation label. #' @param fontFamily Font-family for the annotation label. #' @param cssClass A custom Css Class to give to the annotation label elements. #' @param padding Padding for the label: top, right, bottom, left. #' #' @return A \code{list} that can be used in \code{\link{add_shade}}, \code{\link{add_point}}, #' \code{\link{add_event}}, \code{\link{add_event_marker}}. #' @export #' label <- function(text = NULL, borderColor = NULL, borderWidth = NULL, textAnchor = NULL, position = NULL, offsetX = NULL, offsetY = NULL, background = NULL, color = NULL, fontSize = NULL, fontWeight = NULL, fontFamily = NULL, cssClass = NULL, padding = c(2, 5, 2, 5)) { dropNulls(list( borderColor = borderColor, borderWidth = borderWidth, text = text, textAnchor = textAnchor, position = position, offsetX = offsetX, offsetY = offsetY, style = dropNulls(list( background = background, color = color, fontSize = fontSize, fontWeight = fontWeight, fontFamily = fontFamily, padding = list( top = padding[1], right = padding[2], bottom = padding[3], left = padding[4] ) )) )) } #' Marker for annotations #' #' @param size Size of the marker. #' @param fillColor Fill Color of the marker point. #' @param strokeColor Stroke Color of the marker point. #' @param strokeWidth Stroke Size of the marker point. #' @param shape Shape of the marker: \code{"circle"} or \code{"square"}. #' @param radius Radius of the marker (applies to square shape). #' @param OffsetX Sets the left offset of the marker. #' @param OffsetY Sets the top offset of the marker. #' @param cssClass Additional CSS classes to append to the marker. #' #' @return A \code{list} that can be used in \code{\link{add_point}}. #' @noRd #' marker <- function(size = NULL, fillColor = NULL, strokeColor = NULL, strokeWidth = NULL, shape = NULL, radius = NULL, OffsetX = NULL, OffsetY = NULL, cssClass = NULL) { dropNulls(list( size = size, fillColor = fillColor, strokeColor = strokeColor, strokeWidth = strokeWidth, shape = shape, radius = radius, OffsetX = OffsetX, OffsetY = OffsetY, cssClass = cssClass )) } #' @title Add a shaded area to a chart #' #' @description \code{add_shade()} allow to add a shaded area on specified range, #' \code{add_shade_weekend()} add a shadow on every week-end. #' #' @template ax-default #' @param from Vector of position to start shadow. #' @param to Vector of position to end shadow. #' @param color Color of the shadow. #' @param opacity Opacity of the shadow. #' @param label Add a label to the shade, use a \code{character} #' or see \code{\link{label}} for more controls. #' @param ... Additional arguments, see #' \url{https://apexcharts.com/docs/options/annotations/} for possible options. #' #' @note \code{add_shade_weekend} only works if variable #' used for x-axis is of class \code{Date} or \code{POSIXt}. #' #' #' @export #' #' @name add-shade #' #' @example examples/add_shade.R add_shade <- function(ax, from, to, color = "#848484", opacity = 0.2, label = NULL, ...) { if (length(from) != length(to)) { stop("In add_shade: from and to must be of same length!", call. = FALSE) } add_annotation( ax = ax, type_annotation = "xaxis", as_date = TRUE, x = from, x2 = to, fillColor = color, opacity = opacity, label = label, ... ) } #' @export #' @rdname add-shade add_shade_weekend <- function(ax, color = "#848484", opacity = 0.2, label = NULL, ...) { if (is.null(ax$x$xaxis)) { stop("add_shade_weekend can only be used with apex().", call. = FALSE) } if (inherits(ax$x$xaxis$min, c("Date", "POSIXt"))) { from <- as.Date(format(ax$x$xaxis$min, format = "%Y-%m-%d")) to <- as.Date(format(ax$x$xaxis$max, format = "%Y-%m-%d")) dates <- seq(from = from - 2, to = to + 2, by = "day") if (inherits(ax$x$xaxis$min, "Date")) { sat <- dates[format(dates, format = "%u") == 5] time <- "12:00:00" } else { sat <- dates[format(dates, format = "%u") == 6] time <- "00:00:00" } sun <- sat + 2 ax <- add_shade( ax = ax, from = paste(format(sat, format = "%Y-%m-%d"), time), to = paste(format(sun, format = "%Y-%m-%d"), time), color = color, opacity = opacity, label = label, ... ) } return(ax) } #' @title Add an event to a chart #' #' @description Add a vertical line to mark a special event on a chart. #' #' @template ax-default #' @param when Vector of position to place the event. #' @param color Color of the line. #' @param dash Creates dashes in borders of SVG path. #' A higher number creates more space between dashes in the border. #' Use \code{0} for plain line. #' @param label Add a label to the shade, use a \code{character} #' or see \code{\link{label}} for more controls. #' @param ... Additional arguments, see #' \url{https://apexcharts.com/docs/options/annotations/} for possible options. #' #' #' @export #' #' @seealso \code{\link{add_event_marker}} to add a point. #' #' @example examples/add_event.R add_event <- function(ax, when, color = "#E41A1C", dash = 4, label = NULL, ...) { add_annotation( ax = ax, type_annotation = "xaxis", as_date = TRUE, x = when, borderColor = color, strokeDashArray = dash, label = label, ... ) } #' @title Add an event marker to a chart #' #' @description Add a point with a label based on a datetime. #' #' @param when Vector of position to place the event. #' @inheritParams add_point #' #' @return An [apexchart()] `htmlwidget` object. #' @export #' #' @seealso \code{\link{add_event}} to add a vertical line. #' #' @example examples/add_event_marker.R add_event_marker <- function(ax, when, y, size = 5, color = "#000", fill = "#FFF", width = 2, shape = "circle", radius = 2, label = NULL, ...) { add_annotation( ax = ax, type_annotation = "points", position = "front", as_date = TRUE, x = when, y = y, marker = marker( size = size, fillColor = fill, strokeColor = color, strokeWidth = width, shape = shape, radius = radius ), label = label, ... ) } #' Add horizontal or vertical line #' #' @template ax-default #' @param value Vector of position for the line(s). #' @param color Color(s) of the line(s). #' @param dash Creates dashes in borders of SVG path. #' A higher number creates more space between dashes in the border. #' Use \code{0} for plain line. #' @param label Add a label to the shade, use a \code{character} #' or see \code{\link{label}} for more controls. #' @param ... Additional arguments, see #' \url{https://apexcharts.com/docs/options/annotations/} for possible options. #' #' #' @export #' #' @name add-vh-lines #' #' @example examples/add-lines.R add_hline <- function(ax, value, color = "#000", dash = 0, label = NULL, ...) { add_annotation( ax = ax, type_annotation = "yaxis", position = "front", as_date = FALSE, y = value, borderColor = color, strokeDashArray = dash, label = label, ... ) } #' @export #' @rdname add-vh-lines add_vline <- function(ax, value, color = "#000", dash = 0, label = NULL, ...) { add_annotation( ax = ax, type_annotation = "xaxis", position = "front", as_date = FALSE, x = value, borderColor = color, strokeDashArray = dash, label = label, ... ) } #' Add an annotation point #' #' @template ax-default #' @param x Coordinate(s) on the x-axis. #' @param y Coordinate(s) on the y-axis. #' @param size Size of the marker. #' @param color Stroke Color of the marker point. #' @param fill Fill Color of the marker point. #' @param width Stroke Size of the marker point. #' @param shape Shape of the marker: \code{"circle"} or \code{"square"}. #' @param radius Radius of the marker (applies to square shape). #' @param label Add a label to the shade, use a \code{character} #' or see \code{\link{label}} for more controls. #' @param ... Additional arguments, see #' \url{https://apexcharts.com/docs/options/annotations/} for possible options. #' #' #' @export #' #' @seealso \code{\link{add_event_marker}} to add a point when x-axis is a datetime. #' #' @example examples/add_point.R add_point <- function(ax, x, y, size = 5, color = "#000", fill = "#FFF", width = 2, shape = "circle", radius = 2, label = NULL, ...) { add_annotation( ax = ax, type_annotation = "points", position = "front", as_date = inherits(x, c("Date", "POSIXct")), x = x, y = y, marker = marker( size = size, fillColor = fill, strokeColor = color, strokeWidth = width, shape = shape, radius = radius ), label = label, ... ) }