From 639450cb7dcc29ea24cbdb46a22f8ee0fe6c12d2 Mon Sep 17 00:00:00 2001
From: pvictor <perrier.victor@gmail.com>
Date: Thu, 3 Dec 2020 17:31:04 +0100
Subject: [PATCH] facet_wrap: added scales arg

---
 R/facets.R            | 68 +++++++++++++++++++++++++++++++++++++++++++
 R/utils.R             | 10 ++++---
 examples/facet_wrap.R |  1 +
 man/ax_facet_wrap.Rd  |  1 +
 4 files changed, 76 insertions(+), 4 deletions(-)

diff --git a/R/facets.R b/R/facets.R
index 7e012a4..18013ce 100644
--- a/R/facets.R
+++ b/R/facets.R
@@ -16,9 +16,72 @@ get_facets <- function(data, vars) {
   )
 }
 
+set_scale <- function(ax, values, scales = c("fixed", "free", "free_y", "free_x"), axis = c("x", "y")) {
+  scales <- match.arg(scales)
+  axis <- match.arg(axis)
+  if (is.null(values))
+    return(ax)
+  if (inherits(values, c("numeric", "integer", "Date", "POSIXt"))) {
+    range_vals <- range(pretty(values), na.rm = TRUE)
+  } else {
+    range_vals <- NULL
+  }
+  
+  fmt <- function(x, time = inherits(values, c("Date", "POSIXt"))) {
+    if (is.null(x))
+      return(NULL)
+    if (time)
+      x <- format_date(x)
+    x
+  }
+  
+  fun_axis <- switch(
+    axis,
+    "x" = ax_xaxis,
+    "y" = ax_yaxis
+  )
+  
+  if (scales == "fixed") {
+    ax <- fun_axis(
+      ax = ax,
+      min = fmt(range_vals[1]), 
+      max = fmt(range_vals[2])
+    )
+  } else if (scales == "free") {
+    ax <- fun_axis(
+      ax = ax,
+      min = character(0), 
+      max = character(0)
+    )
+  } else {
+    ax <- fun_axis(
+      ax = ax,
+      min = fmt(range_vals[1]), 
+      max = fmt(range_vals[2])
+    )
+    if (scales == "free_x" & axis == "x") {
+      ax <- fun_axis(
+        ax = ax,
+        min = character(0), 
+        max = character(0)
+      )
+    }
+    if (scales == "free_y" & axis == "y") {
+      ax <- fun_axis(
+        ax = ax,
+        min = character(0), 
+        max = character(0)
+      )
+    }
+  }
+  
+  return(ax)
+}
+
 #' @importFrom rlang eval_tidy is_null is_function
 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$vars)
   lapply(
@@ -33,6 +96,8 @@ build_facets <- function(chart) {
       }
       mapdata <- lapply(chart$x$mapping, eval_tidy, data = facet)
       new$x$ax_opts$series <- make_series(mapdata, chart$x$mapping, chart$x$type, chart$x$serie_name)
+      new <- set_scale(new, mapall$x, scales = chart$x$facet$scales, axis = "x")
+      new <- set_scale(new, mapall$y, scales = chart$x$facet$scales, axis = "y")
       new$height <- chart$x$facet$chart_height
       new$x$facet <- NULL
       class(new) <- setdiff(class(new), "apex_facet")
@@ -84,14 +149,17 @@ ax_facet_wrap <- function(ax,
                           vars, 
                           nrow = NULL,
                           ncol = 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)
   ax$x$facet <- list(
     vars = vars,
     nrow = nrow,
     ncol = ncol,
+    scales = scales,
     labeller = labeller,
     chart_height = chart_height
   )
diff --git a/R/utils.R b/R/utils.R
index c8ce5c1..8a7068f 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -59,13 +59,13 @@ to_posix <- function(x) {
   if (is.null(ax$x$ax_opts[[name]])) {
     ax$x$ax_opts[[name]] <- list(...)
   } else {
-    ax$x$ax_opts[[name]] <- utils::modifyList(
+    ax$x$ax_opts[[name]] <- modifyList(
       x = ax$x$ax_opts[[name]], 
       val = list(...), 
       keep.null = TRUE
     )
   }
-  
+  ax$x$ax_opts[[name]] <- dropNullsOrEmpty(ax$x$ax_opts[[name]])
   return(ax)
 }
 
@@ -77,19 +77,21 @@ to_posix <- function(x) {
 #'
 #' @return A \code{apexcharts} \code{htmlwidget} object.
 #'
+#' @importFrom utils modifyList
+#'
 #' @noRd
 .ax_opt2 <- function(ax, name, l) {
   
   if (is.null(ax$x$ax_opts[[name]])) {
     ax$x$ax_opts[[name]] <- l
   } else {
-    ax$x$ax_opts[[name]] <- utils::modifyList(
+    ax$x$ax_opts[[name]] <- modifyList(
       x = ax$x$ax_opts[[name]], 
       val = l, 
       keep.null = TRUE
     )
   }
-  
+  ax$x$ax_opts[[name]] <- dropNullsOrEmpty(ax$x$ax_opts[[name]])
   return(ax)
 }
 
diff --git a/examples/facet_wrap.R b/examples/facet_wrap.R
index b86b774..6058131 100644
--- a/examples/facet_wrap.R
+++ b/examples/facet_wrap.R
@@ -49,6 +49,7 @@ data("unhcr_ts")
 unhcr_ts %>% 
   subset(population_type == "Refugees (incl. refugee-like situations)") %>% 
   apex(aes(as.Date(paste0(year, "-01-01")), n), type = "line") %>% 
+  ax_yaxis(tickAmount = 5) %>% 
   ax_facet_wrap(vars(continent_origin))
 
 
diff --git a/man/ax_facet_wrap.Rd b/man/ax_facet_wrap.Rd
index 5d6f899..3c404b0 100644
--- a/man/ax_facet_wrap.Rd
+++ b/man/ax_facet_wrap.Rd
@@ -9,6 +9,7 @@ ax_facet_wrap(
   vars,
   nrow = NULL,
   ncol = NULL,
+  scales = c("fixed", "free", "free_y", "free_x"),
   labeller = label_value,
   chart_height = "300px"
 )