facet_wrap: added scales arg
This commit is contained in:
parent
585cbd0bfd
commit
639450cb7d
68
R/facets.R
68
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
|
||||
)
|
||||
|
|
10
R/utils.R
10
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)
|
||||
}
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
||||
|
|
|
@ -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"
|
||||
)
|
||||
|
|
Loading…
Reference in New Issue