From d3126ab26b7a943e064035e353b8c9b504c9b5b0 Mon Sep 17 00:00:00 2001 From: pvictor Date: Thu, 2 Apr 2020 19:33:39 +0200 Subject: [PATCH] add_shade() & add_shade_weekend() --- NAMESPACE | 2 + R/annotations.R | 102 +++++++++++++++++++++++++++++++++++++++++++ R/apex.R | 9 +++- examples/add_shade.R | 24 ++++++++++ man/add-shade.Rd | 63 ++++++++++++++++++++++++++ 5 files changed, 199 insertions(+), 1 deletion(-) create mode 100644 R/annotations.R create mode 100644 examples/add_shade.R create mode 100644 man/add-shade.Rd diff --git a/NAMESPACE b/NAMESPACE index 639e083..ec795fa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,8 @@ export("%>%") export(JS) +export(add_shade) +export(add_shade_weekend) export(aes) export(apex) export(apexchart) diff --git a/R/annotations.R b/R/annotations.R new file mode 100644 index 0000000..f8ab137 --- /dev/null +++ b/R/annotations.R @@ -0,0 +1,102 @@ + +#' @title Add a shaded area to a chart +#' +#' @description \code{add_shade()} allow to add a shadow area on specified range, +#' \code{add_shade_weekend()} add a shadow on every week-end. +#' +#' @param ax An \code{apexcharts} \code{htmlwidget} object. +#' @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 ... 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}. +#' +#' @return An \code{apexcharts} \code{htmlwidget} object. +#' @export +#' +#' @name add-shade +#' +#' @example examples/add_shade.R +add_shade <- function(ax, from, to, color = "#848484", opacity = 0.2, ...) { + if (length(from) != length(to)) { + stop("In add_shade: from and to must be of same length!", call. = FALSE) + } + len <- length(from) + config <- list( + x = from, + x2 = to, + fillColor = color, + opacity = opacity, + ... + ) + config <- rapply( + object = config, + f = rep_len, + length.out = len, + how = "replace" + ) + extract <- function(el, position) { + `[`(el, position) + } + xaxis <- lapply( + X = seq_len(len), + FUN = function(i) { + this <- rapply( + object = config, + f = extract, + position = i, + how = "list" + ) + this$x <- format_date(this$x) + this$x2 <- format_date(this$x2) + this + } + ) + if (!is.null(ax$x$ax_opts$annotations$xaxis)) { + xaxis <- c(xaxis, ax$x$ax_opts$annotations$xaxis) + ax$x$ax_opts$annotations$xaxis <- NULL + } + ax_annotations( + ax = ax, + position = "back", + xaxis = xaxis + ) +} + + + +#' @export +#' @rdname add-shade +add_shade_weekend <- function(ax, color = "#848484", opacity = 0.2, ...) { + 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, + ... + ) + } + return(ax) +} + + diff --git a/R/apex.R b/R/apex.R index 20dd584..d31ee0f 100644 --- a/R/apex.R +++ b/R/apex.R @@ -63,12 +63,19 @@ apex <- function(data, mapping, type = "column", ..., ) } opts <- modifyList(opts, choose_config(type, mapdata)) - apexchart( + ax <- apexchart( ax_opts = opts, width = width, height = height, elementId = elementId, auto_update = auto_update ) + if (inherits(mapdata$x, c("character", "Date", "POSIXt", "numeric", "integer"))) { + ax$x$xaxis <- list( + min = min(mapdata$x, na.rm = TRUE), + max = max(mapdata$x, na.rm = TRUE) + ) + } + return(ax) } diff --git a/examples/add_shade.R b/examples/add_shade.R new file mode 100644 index 0000000..e3021fd --- /dev/null +++ b/examples/add_shade.R @@ -0,0 +1,24 @@ + +library(apexcharter) +data("consumption") + +# specify from and to date +apex(consumption, aes(date, value, group = type), "spline") %>% + add_shade(from = "2020-01-06", to = "2020-01-20") + +# you can add several shadows +apex(consumption, aes(date, value, group = type), "spline") %>% + add_shade(from = "2020-01-06", to = "2020-01-20") %>% + add_shade(from = "2020-02-04", to = "2020-02-10") + +# or use a vector +apex(consumption, aes(date, value, group = type), "spline") %>% + add_shade(from = c("2020-01-06", "2020-02-04"), to = c("2020-01-20", "2020-02-10")) + + +# automatically add shadow on week-ends +apex(consumption, aes(date, value, group = type), "spline") %>% + add_shade_weekend() + + + diff --git a/man/add-shade.Rd b/man/add-shade.Rd new file mode 100644 index 0000000..2a69e54 --- /dev/null +++ b/man/add-shade.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/annotations.R +\name{add-shade} +\alias{add-shade} +\alias{add_shade} +\alias{add_shade_weekend} +\title{Add a shaded area to a chart} +\usage{ +add_shade(ax, from, to, color = "#848484", opacity = 0.2, ...) + +add_shade_weekend(ax, color = "#848484", opacity = 0.2, ...) +} +\arguments{ +\item{ax}{An \code{apexcharts} \code{htmlwidget} object.} + +\item{from}{Vector of position to start shadow.} + +\item{to}{Vector of position to end shadow.} + +\item{color}{Color of the shadow.} + +\item{opacity}{Opacity of the shadow.} + +\item{...}{Additional arguments, see +\url{https://apexcharts.com/docs/options/annotations/} for possible options.} +} +\value{ +An \code{apexcharts} \code{htmlwidget} object. +} +\description{ +\code{add_shade()} allow to add a shadow area on specified range, +\code{add_shade_weekend()} add a shadow on every week-end. +} +\note{ +\code{add_shade_weekend} only works if variable +used for x-axis is of class \code{Date} or \code{POSIXt}. +} +\examples{ + +library(apexcharter) +data("consumption") + +# specify from and to date +apex(consumption, aes(date, value, group = type), "spline") \%>\% + add_shade(from = "2020-01-06", to = "2020-01-20") + +# you can add several shadows +apex(consumption, aes(date, value, group = type), "spline") \%>\% + add_shade(from = "2020-01-06", to = "2020-01-20") \%>\% + add_shade(from = "2020-02-04", to = "2020-02-10") + +# or use a vector +apex(consumption, aes(date, value, group = type), "spline") \%>\% + add_shade(from = c("2020-01-06", "2020-02-04"), to = c("2020-01-20", "2020-02-10")) + + +# automatically add shadow on week-ends +apex(consumption, aes(date, value, group = type), "spline") \%>\% + add_shade_weekend() + + + +}