added apex_facet_grid()

NAMESPACE

@@ -26,6 +26,7 @@ export(ax_chart)
 export(ax_colors)
 export(ax_colors_manual)
 export(ax_dataLabels)
+export(ax_facet_grid)
 export(ax_facet_wrap)
 export(ax_fill)
 export(ax_grid)

R/facets.R

@@ -1,9 +1,11 @@
 
 #' @importFrom rlang eval_tidy
-get_facets <- function(data, vars) {
-  byvars <- lapply(X = vars, FUN = eval_tidy, data = data)
-  facets <- split(x = data, f = byvars, sep = "|__|")
-  lapply(
+get_facets <- function(data, rows, cols, type = c("wrap", "grid")) {
+  type <- match.arg(type)
+  byrows <- lapply(X = rows, FUN = eval_tidy, data = data)
+  bycols <- lapply(X = cols, FUN = eval_tidy, data = data)
+  facets <- split(x = data, f = c(bycols, byrows), sep = "|__|")
+  facets <- lapply(
     X = seq_along(facets),
     FUN = function(i) {
       facet <- facets[[i]]
@@ -14,8 +16,29 @@ get_facets <- function(data, vars) {
       facet
     }
   )
+  label_row <- lapply(byrows, unique)
+  label_row <- lapply(label_row, sort)
+  label_row <- apply(expand.grid(label_row), 1, paste, collapse = "*")
+  label_col <- lapply(bycols, unique)
+  label_col <- lapply(label_col, sort)
+  label_col <- apply(expand.grid(label_col), 1, paste, collapse = "*")
+  list(
+    facets = facets,
+    nrow = if (identical(type, "grid")) n_facet(byrows) else NULL,
+    ncol = if (identical(type, "grid")) n_facet(bycols) else NULL,
+    label_row = label_row,
+    label_col = label_col
+  )
 }
 
+n_facet <- function(l) {
+  l <- lapply(l, function(x) {
+    length(unique(x))
+  })
+  Reduce(`*`, l)
+}
+
+
 set_scale <- function(ax, values, scales = c("fixed", "free", "free_y", "free_x"), axis = c("x", "y")) {
   if (is.null(scales))
     return(ax)
@@ -85,9 +108,17 @@ build_facets <- function(chart) {
   data <- chart$x$data
   mapall <- lapply(chart$x$mapping, eval_tidy, data = data)
   labeller <- chart$x$facet$labeller
-  facets_data <- get_facets(data, chart$x$facet$facets)
+  facets_list <- get_facets(
+    data = data, 
+    rows = chart$x$facet$facets_row, 
+    cols = chart$x$facet$facets_col,
+    type = chart$x$facet$type
+  )
+  facets_data <- facets_list$facets
+  nrow_ <- facets_list$nrow %||% chart$x$facet$nrow
+  ncol_ <- facets_list$ncol %||% chart$x$facet$ncol
   nums <- seq_along(facets_data)
-  dims <- get_grid_dims(nums, nrow = chart$x$facet$nrow, ncol = chart$x$facet$ncol)
+  dims <- get_grid_dims(nums, nrow = nrow_, ncol = ncol_)
   grid <- matrix(
     data = c(
       nums,
@@ -98,12 +129,12 @@ build_facets <- function(chart) {
     byrow = TRUE
   )
   lrow <- get_last_row(grid)
-  lapply(
+  facets <- lapply(
     X = nums,
     FUN = function(i) {
       new <- chart
       facet <- facets_data[[i]]
-      if (!is_null(labeller) && is_function(labeller)) {
+      if (identical(chart$x$facet$type, "wrap") && !is_null(labeller) && is_function(labeller)) {
         keys <- attr(facet, "keys")
         text <- labeller(keys)
         new <- ax_title(new, text = text, margin = 0, floating = length(text) <= 1)
@@ -136,6 +167,14 @@ build_facets <- function(chart) {
       return(new)
     }
   )
+  list(
+    facets = facets,
+    type = chart$x$facet$type,
+    nrow = facets_list$nrow, 
+    ncol = facets_list$ncol,
+    label_row = facets_list$label_row,
+    label_col = facets_list$label_col
+  )
 }
 
 
@@ -161,6 +200,8 @@ get_last_row <- function(mat) {
 #' @return An \code{apexcharts} \code{htmlwidget} object.
 #' @export
 #' 
+#' @name apex-facets
+#' 
 #' @importFrom rlang quos syms
 #'
 #' @example examples/facet_wrap.R
@@ -177,18 +218,93 @@ ax_facet_wrap <- function(ax,
   if (is.character(facets))
     facets <- quos(!!!syms(facets))
   ax$x$facet <- list(
-    facets = facets,
+    facets_row = facets,
     nrow = nrow,
     ncol = ncol,
     scales = scales,
     labeller = labeller,
-    chart_height = chart_height
+    chart_height = chart_height,
+    type = "wrap"
   )
   class(ax) <- c("apex_facet", class(ax))
   return(ax)
 }
 
 
+#' @param rows,cols A set of variables or expressions quoted by vars() and defining faceting groups on the rows or columns dimension. 
+#' @export
+#' 
+#' @rdname apex-facets
+ax_facet_grid <- function(ax, 
+                          rows = NULL,
+                          cols = NULL,
+                          scales = c("fixed", "free", "free_y", "free_x"),
+                          labeller = label_value,
+                          chart_height = "300px") {
+  if (!inherits(ax, "apex"))
+    stop("ax_facet_wrap only works with charts generated with apex()", call. = FALSE)
+  scales <- match.arg(scales)
+  if (!is.null(rows) && is.character(rows))
+    rows <- quos(!!!syms(rows))
+  if (!is.null(cols) && is.character(cols))
+    cols <- quos(!!!syms(cols))
+  ax$x$facet <- list(
+    facets_row = rows,
+    facets_col = cols,
+    nrow = NULL,
+    ncol = NULL,
+    scales = scales,
+    labeller = labeller,
+    chart_height = chart_height,
+    type = "grid"
+  )
+  class(ax) <- c("apex_facet", class(ax))
+  return(ax)
+}
+
+
+
+
+
+# Tag ---------------------------------------------------------------------
+
+build_facet_tag <- function(x) {
+  facets <- build_facets(x)
+  if (identical(facets$type, "wrap")) {
+    TAG <- build_grid(facets$facets, nrow = x$x$facet$nrow, ncol = x$x$facet$ncol)
+  } else if (identical(facets$type, "grid")) {
+    content <- facets$facets
+    if (!is.null(facets$nrow)) {
+      for (i in seq_along(facets$label_row)) {
+        content <- append(
+          x = content, 
+          values = tagList(tags$div(class = "apexcharter-facet-row-label", facets$label_row[i])),
+          after = ((facets$ncol %||% 1 + 1) * i) - 1
+        )
+      }
+    }
+    if (!is.null(facets$ncol)) {
+      content <- tagList(
+        lapply(facets$label_col, FUN = tags$div, class = "apexcharter-facet-col-label"),
+        if (!is.null(facets$nrow)) tags$div(),
+        content
+      )
+    }
+    TAG <- build_grid(
+      content, 
+      nrow = facets$nrow %||% 1, 
+      ncol = facets$ncol %||% 1,
+      row_label = if (!is.null(facets$ncol)) "30px" else NULL,
+      col_label = if (!is.null(facets$nrow)) "30px" else NULL,
+      row_gap = "3px", 
+      col_gap = "3px"
+    )
+  } else {
+    stop("Facetting must be wrap or grid", call. = FALSE)
+  }
+}
+
+
 
 
 
@@ -243,12 +359,7 @@ renderApexfacet <- function(expr, env = parent.frame(), quoted = FALSE) {
           call. = FALSE
         )
       }
-      facets_charts <- build_facets(result)
-      TAG <- build_grid(
-        content = facets_charts,
-        nrow = result$x$facet$nrow,
-        ncol = result$x$facet$ncol
-      )
+      TAG <- build_facet_tag(result)
       rendered <- renderTags(TAG)
       deps <- lapply(
         X = resolveDependencies(rendered$dependencies),
@@ -270,14 +381,12 @@ renderApexfacet <- function(expr, env = parent.frame(), quoted = FALSE) {
 
 #' @export
 print.apex_facet <- function(x, ...) {
-  facets_charts <- build_facets(x)
-  TAG <- build_grid(facets_charts, nrow = x$x$facet$nrow, ncol = x$x$facet$ncol)
+  TAG <- build_facet_tag(x)
   print(htmltools::browsable(TAG))
 }
 
 knit_print.apex_facet <- function(x, ..., options = NULL) {
-  facets_charts <- build_facets(x)
-  TAG <- build_grid(facets_charts, nrow = x$x$facet$nrow, ncol = x$x$facet$ncol)
+  TAG <- build_facet_tag(x)
   knitr::knit_print(htmltools::browsable(TAG), options = options, ...)
 }
 

R/grid.R

@@ -21,19 +21,43 @@ get_grid_dims <- function(content, nrow, ncol) {
 #' @importFrom htmltools tags
 build_grid <- function(content,
                        nrow = NULL,
-                       ncol = NULL, 
+                       ncol = NULL,
+                       row_gap = "5px", 
                        col_gap = "0px",
-                       row_gap = "5px",
+                       row_label = NULL,
+                       col_label = NULL,
                        height = NULL,
                        width = NULL) {
   d <- get_grid_dims(content, nrow, ncol)
+  if (is.null(col_label)) {
+    col_style <- sprintf(
+      "-ms-grid-columns: repeat(%1$s, 1fr); grid-template-columns: repeat(%1$s, 1fr);",
+      d$ncol
+    )
+  } else {
+    col_style <- sprintf(
+      "-ms-grid-columns: repeat(%1$s, 1fr) %2$s; grid-template-columns: repeat(%1$s, 1fr) %2$s;", 
+      d$ncol, col_label
+    )
+  }
+  if (is.null(row_label)) {
+    row_style <- sprintf(
+      "-ms-grid-rows: repeat(%1$s, 1fr); grid-template-rows: repeat(%1$s, 1fr);", 
+      d$nrow
+    )
+  } else {
+    row_style <- sprintf(
+      "-ms-grid-rows: %2$s repeat(%1$s, 1fr); grid-template-rows: %2$s repeat(%1$s, 1fr);", 
+      d$nrow, row_label
+    )
+  }
   tags$div(
     class = "apexcharter-grid-container",
     style = if (!is.null(height)) paste0("height:", height, ";"),
     style = if (!is.null(width)) paste0("width:", width, ";"),
     style = "display:-ms-grid; display: grid;",
-    style = sprintf("-ms-grid-columns: repeat(%1$s, 1fr); grid-template-columns: repeat(%1$s, 1fr);", d$ncol),
-    style = sprintf("-ms-grid-rows: repeat(%1$s, 1fr); grid-template-rows: repeat(%1$s, 1fr);", d$nrow),
+    style = col_style,
+    style = row_style,
     style = sprintf("grid-column-gap: %s;", col_gap),
     style = sprintf("grid-row-gap: %s;", row_gap),
     content

examples/facet_grid.R

@@ -0,0 +1,18 @@
+library(apexcharter)
+
+# Scatter ----
+
+data("mpg", package = "ggplot2")
+
+# Only rows
+apex(mpg, aes(displ, cty), type = "scatter") %>% 
+  ax_facet_grid(rows = vars(drv), chart_height = "200px")
+
+# Only cols
+apex(mpg, aes(displ, cty), type = "scatter") %>% 
+  ax_facet_grid(cols = vars(year))
+
+# Rows and Cols
+apex(mpg, aes(displ, cty), type = "scatter") %>% 
+  ax_facet_grid(rows = vars(drv), cols = vars(year))
+

examples/facet_wrap.R

@@ -36,6 +36,9 @@ apex(mpg, aes(displ, cty), type = "scatter") %>%
 apex(mpg, aes(displ, cty), type = "scatter") %>% 
   ax_facet_wrap(vars(year, drv))
 
+apex(mpg, aes(displ, cty), type = "scatter") %>% 
+  ax_facet_wrap(vars(year, drv), ncol = 2, nrow = 3)
+
 apex(mpg, aes(displ, cty), type = "scatter") %>% 
   ax_chart(toolbar = list(show = FALSE)) %>% 
   ax_facet_wrap(

inst/htmlwidgets/apexcharter.css

@@ -9,3 +9,20 @@
 .apexcharter-grid-container > div {
   min-width: 0;
 }
+
+.apexcharter-facet-col-label {
+  background:#E6E6E6; 
+  text-align: center;
+  font-weight: bold; 
+  line-height: 30px;
+}
+
+.apexcharter-facet-row-label {
+  background:#E6E6E6; 
+  text-align: center; 
+  font-weight: bold;
+  writing-mode: vertical-rl; 
+  text-orientation: mixed; 
+  line-height: 30px;
+}
+

man/apex-facets.Rd

@@ -1,7 +1,9 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/facets.R
-\name{ax_facet_wrap}
+\name{apex-facets}
+\alias{apex-facets}
 \alias{ax_facet_wrap}
+\alias{ax_facet_grid}
 \title{Facet wrap for ApexCharts}
 \usage{
 ax_facet_wrap(
@@ -13,6 +15,15 @@ ax_facet_wrap(
   labeller = label_value,
   chart_height = "300px"
 )
+
+ax_facet_grid(
+  ax,
+  rows = NULL,
+  cols = NULL,
+  scales = c("fixed", "free", "free_y", "free_x"),
+  labeller = label_value,
+  chart_height = "300px"
+)
 }
 \arguments{
 \item{ax}{An \code{apexcharts} \code{htmlwidget} object.}
@@ -27,6 +38,8 @@ free (\code{"free"}), or free in one dimension (\code{"free_x"}, \code{"free_y"}
 \item{labeller}{A function with one argument containing for each facet the value of the faceting variable.}
 
 \item{chart_height}{Individual chart height.}
+
+\item{rows, cols}{A set of variables or expressions quoted by vars() and defining faceting groups on the rows or columns dimension.}
 }
 \value{
 An \code{apexcharts} \code{htmlwidget} object.
@@ -73,6 +86,9 @@ apex(mpg, aes(displ, cty), type = "scatter") \%>\%
 apex(mpg, aes(displ, cty), type = "scatter") \%>\% 
   ax_facet_wrap(vars(year, drv))
 
+apex(mpg, aes(displ, cty), type = "scatter") \%>\% 
+  ax_facet_wrap(vars(year, drv), ncol = 2, nrow = 3)
+
 apex(mpg, aes(displ, cty), type = "scatter") \%>\% 
   ax_chart(toolbar = list(show = FALSE)) \%>\% 
   ax_facet_wrap(