facet: added labeller

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