added timeline charts

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: apexcharter
-Version: 0.1.3.910
+Version: 0.1.3.920
 Title: Create Interactive Chart with the JavaScript 'ApexCharts' Library
 Description: Provides an 'htmlwidgets' interface to 'apexcharts.js'. 
   'Apexcharts' is a modern JavaScript charting library to build interactive charts and visualizations with simple API.

R/apex.R

@@ -10,12 +10,15 @@
 #' @param type Specify the chart type. Available Options:
 #'  \code{"column"}, \code{"bar"}, \code{"line"},
 #'  \code{"area"}, \code{"spline"}, \code{"pie"}, \code{"donut"},
-#'  \code{"radialBar"}, \code{"radar"}, \code{"scatter"}, \code{"heatmap"}.
+#'  \code{"radialBar"}, \code{"radar"}, \code{"scatter"}, \code{"heatmap"}, 
+#'  \code{"timeline"}.
 #' @param ... Other arguments passed on to methods. Not currently used.
 #' @param auto_update In Shiny application, update existing chart
 #'  rather than generating new one.
 #' @param update_options In Shiny application, update or not global options
 #'  for chart. Applicable only if \code{auto_update} is \code{TRUE}.
+#' @param serie_name Name for the serie displayed in tooltip,
+#'  only used for single serie.
 #' @param width A numeric input in pixels.
 #' @param height A numeric input in pixels.
 #' @param elementId Use an explicit element ID for the widget.
@@ -30,10 +33,16 @@
 #' @example examples/apex.R
 apex <- function(data, mapping, type = "column", ..., 
                  auto_update = TRUE, update_options = FALSE, 
+                 serie_name = NULL,
                  width = NULL, height = NULL, elementId = NULL) {
-  type <- match.arg(type, c("column", "bar", "line", "area", "spline", "area-spline",
-                            "pie", "donut", "radialBar", "radar", "scatter", "heatmap",
-                            "rangeBar"))
+  type <- match.arg(
+    arg = type, 
+    choices = c(
+      "column", "bar", "line", "area", "spline", "area-spline",
+      "pie", "donut", "radialBar", "radar", "scatter", "heatmap",
+      "timeline"
+    )
+  )
   data <- as.data.frame(data)
   if (identical(type, "heatmap")) {
     mapping <- rename_aes_heatmap(mapping)
@@ -48,7 +57,7 @@ apex <- function(data, mapping, type = "column", ...,
   } else {
     opts <- list(
       chart = list(type = correct_type(type)),
-      series = make_series(mapdata, mapping, type)
+      series = make_series(mapdata, mapping, type, serie_name)
     )
   }
   opts <- modifyList(opts, choose_config(type, mapdata))
@@ -63,42 +72,49 @@ apex <- function(data, mapping, type = "column", ...,
 
 
 # Construct series
-make_series <- function(mapdata, mapping, type) {
-  mapdata <- as.data.frame(mapdata)
-  series_names <- "Series"
-  x_order <- unique(mapdata$x)
-  if (is_x_datetime(mapdata)) {
-    add_names <- FALSE
+make_series <- function(mapdata, mapping, type = NULL, serie_name = NULL) {
+  if (identical(type, "timeline")) {
+    if (!all(c("x", "start", "end") %in% names(mapping)))
+      stop("For timeline charts 'x', 'start', and 'end' aesthetice must be provided.", call. = FALSE)
+    if (is.null(mapdata$group))
+      mapdata$group <- serie_name %||% rlang::as_label(mapping$x)
+    series <- parse_timeline_data(mapdata)
   } else {
-    add_names <- names(mapping)
-  }
-  if (!is.null(mapping$y))
-    series_names <- rlang::as_label(mapping$y)
-  series <- list(list(
-    name = series_names,
-    data = parse_df(mapdata, add_names = add_names)
-  ))
-  if (is_grouped(names(mapping))) {
-    mapdata <- rename_aes(mapdata)
-    len_grp <- tapply(mapdata$group, mapdata$group, length)
-    if (length(unique(len_grp)) > 1) {
-      warning("apex: all groups must have same length! Use can use `tidyr::complete` for this.")
+    mapdata <- as.data.frame(mapdata)
+    x_order <- unique(mapdata$x)
+    if (is_x_datetime(mapdata)) {
+      add_names <- FALSE
+    } else {
+      add_names <- names(mapping)
     }
-    series <- lapply(
-      X = unique(mapdata$group),
-      FUN = function(x) {
-        data <- mapdata[mapdata$group %in% x, ]
-        data <- data[, setdiff(names(data), "group"), drop = FALSE]
-        data <- data[match(x = x_order, table = data$x, nomatch = 0L), , drop = FALSE]
-        list(
-          name = x,
-          data = parse_df(
-            data = data, 
-            add_names = add_names
-          )
-        )
+    if (is.null(serie_name) & !is.null(mapping$y))
+      serie_name <- rlang::as_label(mapping$y)
+    series <- list(list(
+      name = serie_name,
+      data = parse_df(mapdata, add_names = add_names)
+    ))
+    if (is_grouped(names(mapping))) {
+      mapdata <- rename_aes(mapdata)
+      len_grp <- tapply(mapdata$group, mapdata$group, length)
+      if (length(unique(len_grp)) > 1) {
+        warning("apex: all groups must have same length! Use can use `tidyr::complete` for this.")
       }
-    )
+      series <- lapply(
+        X = unique(mapdata$group),
+        FUN = function(x) {
+          data <- mapdata[mapdata$group %in% x, ]
+          data <- data[, setdiff(names(data), "group"), drop = FALSE]
+          data <- data[match(x = x_order, table = data$x, nomatch = 0L), , drop = FALSE]
+          list(
+            name = x,
+            data = parse_df(
+              data = data, 
+              add_names = add_names
+            )
+          )
+        }
+      )
+    }
   }
   series
 }
@@ -148,6 +164,8 @@ correct_type <- function(type) {
     "bar"
   } else if (identical(type, "spline")) {
     "line"
+  } else if (identical(type, "timeline")) {
+    "rangeBar"
   } else {
     type
   }
@@ -177,6 +195,7 @@ choose_config <- function(type, mapdata) {
     "area" = config_line(datetime = datetime),
     "spline" = config_line(curve = "smooth", datetime = datetime),
     "scatter" = config_scatter(range_x = range_x, range_y = range_y),
+    "timeline" = config_timeline(),
     list()
   )
 }
@@ -232,5 +251,16 @@ config_scatter <- function(range_x, range_y) {
   )
 }
 
-
+config_timeline <- function() {
+  list(
+    plotOptions = list(
+      bar = list(
+        horizontal = TRUE
+      )
+    ),
+    xaxis = list(
+      type = "datetime"
+    )
+  )
+}
 

R/parse-data.R

@@ -62,3 +62,52 @@ parse_df <- function(data, add_names = FALSE) {
   )
   return(ll)
 }
+
+
+
+#' @importFrom htmlwidgets JS
+js_date <- function(x) {
+  JS(sprintf("new Date('%s').getTime()", x))
+}
+
+parse_timeline_data <- function(.list) {
+  if (is.null(.list$group)) {
+    lapply(
+      X = seq_len(length(.list[[1]])),
+      FUN = function(i) {
+        val <- lapply(.list, `[[`, i)
+        l <- list(
+          x = val$x,
+          y = list(
+            js_date(val$start),
+            js_date(val$end)
+          )
+        )
+        if (!is.null(val$fill)) {
+          l$fillColor <- val$fill
+        }
+        l
+      }
+    )
+  } else {
+    grouped <- as.data.frame(.list, stringsAsFactors = FALSE)
+    grouped$group <- NULL
+    grouped <- split(
+      x = grouped,
+      f = .list$group
+    )
+    grouped <- lapply(grouped, as.list)
+    lapply(
+      X = names(grouped),
+      FUN = function(name) {
+        list(
+          name = name,
+          data = parse_timeline_data(grouped[[name]])
+        )
+      }
+    )
+  }
+}
+
+
+

examples/timeline.R

@@ -0,0 +1,25 @@
+library(apexcharter)
+
+data("presidential", package = "ggplot2")
+
+# Basic
+apex(presidential, aes(x = name, start = start, end = end), "timeline")
+
+# With groups
+apex(presidential, 
+     aes(x = name, start = start, end = end, group = party),
+     "timeline")
+
+# With groups but force position
+apex(presidential, 
+     aes(x = name, start = start, end = end, group = party),
+     "timeline") %>% 
+  ax_xaxis(categories = presidential$name)
+# Bush appears twice
+
+
+# With custom colors
+presidential$color <- ifelse(presidential$party == "Democratic", "#00355f", "#c51c22")
+apex(presidential, 
+     aes(x = name, start = start, end = end, fill = color),
+     "timeline")

man/apex.Rd

@@ -11,6 +11,7 @@ apex(
   ...,
   auto_update = TRUE,
   update_options = FALSE,
+  serie_name = NULL,
   width = NULL,
   height = NULL,
   elementId = NULL
@@ -25,7 +26,8 @@ a \code{data.frame}, it will be coerced to with \code{as.data.frame}.}
 \item{type}{Specify the chart type. Available Options:
 \code{"column"}, \code{"bar"}, \code{"line"},
 \code{"area"}, \code{"spline"}, \code{"pie"}, \code{"donut"},
-\code{"radialBar"}, \code{"radar"}, \code{"scatter"}, \code{"heatmap"}.}
+\code{"radialBar"}, \code{"radar"}, \code{"scatter"}, \code{"heatmap"}, 
+\code{"timeline"}.}
 
 \item{...}{Other arguments passed on to methods. Not currently used.}
 
@@ -35,6 +37,9 @@ rather than generating new one.}
 \item{update_options}{In Shiny application, update or not global options
 for chart. Applicable only if \code{auto_update} is \code{TRUE}.}
 
+\item{serie_name}{Name for the serie displayed in tooltip,
+only used for single serie.}
+
 \item{width}{A numeric input in pixels.}
 
 \item{height}{A numeric input in pixels.}