diff --git a/NAMESPACE b/NAMESPACE index 6ea5f48..a1c38c2 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/facets.R b/R/facets.R index 1595419..14fab34 100644 --- a/R/facets.R +++ b/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, ...) } diff --git a/R/grid.R b/R/grid.R index 1aa9eb7..4b70364 100644 --- a/R/grid.R +++ b/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 diff --git a/examples/facet_grid.R b/examples/facet_grid.R new file mode 100644 index 0000000..010f0fd --- /dev/null +++ b/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)) + diff --git a/examples/facet_wrap.R b/examples/facet_wrap.R index 23a581b..0aba7cf 100644 --- a/examples/facet_wrap.R +++ b/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( diff --git a/inst/htmlwidgets/apexcharter.css b/inst/htmlwidgets/apexcharter.css index ed9b2a5..a9ba20b 100644 --- a/inst/htmlwidgets/apexcharter.css +++ b/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; +} + diff --git a/man/ax_facet_wrap.Rd b/man/apex-facets.Rd similarity index 86% rename from man/ax_facet_wrap.Rd rename to man/apex-facets.Rd index dec5219..8b90310 100644 --- a/man/ax_facet_wrap.Rd +++ b/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(