diff --git a/R/facets.R b/R/facets.R index ef31b34..27d2ca0 100644 --- a/R/facets.R +++ b/R/facets.R @@ -2,20 +2,35 @@ #' @importFrom rlang eval_tidy get_facets <- function(data, vars) { byvars <- lapply(X = vars, FUN = eval_tidy, data = data) - split(x = data, f = byvars, sep = "|__|") + facets <- split(x = data, f = byvars, sep = "|__|") + lapply( + X = seq_along(facets), + FUN = function(i) { + facet <- facets[[i]] + attr(facet, "keys") <- strsplit(x = names(facets)[i], split = "|__|", fixed = TRUE) + facet + } + ) } -#' @importFrom rlang eval_tidy -buil_facets <- function(chart, data, vars, mapping, type, serie_name, height) { - facets_data <- get_facets(data, vars) +#' @importFrom rlang eval_tidy is_null is_function +buil_facets <- function(chart, data, facets_args, mapping, type, serie_name) { + labeller <- facets_args$labeller + facets_data <- get_facets(data, facets_args$vars) lapply( X = seq_along(facets_data), FUN = function(i) { new <- chart - mapdata <- lapply(mapping, eval_tidy, data = facets_data[[i]]) + facet <- facets_data[[i]] + if (!is_null(labeller) && is_function(labeller)) { + keys <- attr(facet, "keys") + # browser() + new <- ax_title(new, text = labeller(keys)) + } + mapdata <- lapply(mapping, eval_tidy, data = facet) new$x$ax_opts$series <- make_series(mapdata, mapping, type, serie_name) new$x$facet <- NULL - new$height <- height + new$height <- facets_args$chart_height class(new) <- setdiff(class(new), "apex_facet") return(new) } @@ -53,14 +68,12 @@ print.apex_facet <- function(x, ...) { facets_charts <- buil_facets( chart = x, data = x$x$data, - vars = x$x$facet$vars, mapping = x$x$mapping, type = x$x$type, serie_name = x$x$serie_name, - height = x$x$facet$chart_height + facets_args = x$x$facet ) TAG <- build_grid(facets_charts, nrow = x$x$facet$nrow, ncol = x$x$facet$ncol) - print(str(TAG, max.level = 1)) print(htmltools::browsable(TAG)) } @@ -76,13 +89,19 @@ print.apex_facet <- function(x, ...) { #' @export #' #' @examples -ax_facet_wrap <- function(ax, vars, nrow = NULL, ncol = NULL, chart_height = "300px") { +ax_facet_wrap <- function(ax, + vars, + nrow = NULL, + ncol = NULL, + labeller = ggplot2::label_value, + chart_height = "300px") { if (!inherits(ax, "apex")) stop("ax_facet_wrap only works with charts generated with apex()", call. = FALSE) ax$x$facet <- list( vars = vars, nrow = nrow, ncol = ncol, + labeller = labeller, chart_height = chart_height ) class(ax) <- c("apex_facet", class(ax))