add_shade() & add_shade_weekend()

NAMESPACE

@@ -2,6 +2,8 @@
 
 export("%>%")
 export(JS)
+export(add_shade)
+export(add_shade_weekend)
 export(aes)
 export(apex)
 export(apexchart)

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)
+}
+
+

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)
 }
 
 

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()
+
+
+

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()
+
+
+
+}