From 456224c866ecad5cccdcdbe78e8a80215b168cdc Mon Sep 17 00:00:00 2001 From: pvictor Date: Wed, 4 Sep 2024 09:43:25 +0200 Subject: [PATCH] dev facet_wrap --- DESCRIPTION | 3 +- NAMESPACE | 5 + R/facets.R | 238 ++++++++++++++++++++++++++++++++++-------- R/layers.R | 58 +++++----- examples/dev-facet.R | 168 ++++++++++------------------- examples/facet_wrap.R | 35 +++++++ man/v_facet_wrap.Rd | 71 +++++++++++++ 7 files changed, 389 insertions(+), 189 deletions(-) create mode 100644 examples/facet_wrap.R create mode 100644 man/v_facet_wrap.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 7d0d76f..11e3fde 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,7 +15,8 @@ Imports: ggplot2, htmlwidgets, magrittr, - rlang + rlang, + scales Suggests: bslib, knitr, diff --git a/NAMESPACE b/NAMESPACE index f3caf20..af6bbc6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ export(v_area) export(v_bar) export(v_boxplot) export(v_circlepacking) +export(v_facet_wrap) export(v_gauge) export(v_heatmap) export(v_hist) @@ -69,6 +70,7 @@ export(vmap) importFrom(ggplot2,aes) importFrom(ggplot2,geom_boxplot) importFrom(ggplot2,geom_jitter) +importFrom(ggplot2,geom_smooth) importFrom(ggplot2,ggplot) importFrom(ggplot2,label_value) importFrom(ggplot2,layer_data) @@ -84,13 +86,16 @@ importFrom(htmlwidgets,shinyWidgetOutput) importFrom(htmlwidgets,sizingPolicy) importFrom(magrittr,"%>%") importFrom(rlang,"%||%") +importFrom(rlang,as_label) importFrom(rlang,eval_tidy) importFrom(rlang,exec) importFrom(rlang,has_name) importFrom(rlang,is_list) importFrom(rlang,is_named) +importFrom(rlang,quos) importFrom(rlang,set_names) importFrom(rlang,sym) importFrom(rlang,syms) importFrom(stats,complete.cases) +importFrom(utils,head) importFrom(utils,modifyList) diff --git a/R/facets.R b/R/facets.R index 7befc76..ef48eb0 100644 --- a/R/facets.R +++ b/R/facets.R @@ -1,34 +1,92 @@ +#' @title Facets for vchart +#' +#' @description Create matrix of charts by row and column faceting variable (`v_facet_grid`), +#' or by specified number of row and column for faceting variable(s) (`v_facet_wrap`). +#' +#' @param vc A chart initialized with [vchart()]. +#' @param facets Variable(s) to use for facetting, wrapped in `vars(...)`. +#' @param nrow,ncol Number of row and column in output matrix. +#' @param scales Should scales be fixed (`"fixed"`, the default), +#' free (`"free"`), or free in one dimension (`"free_x"`, `"free_y"`)? +#' @param labeller A function with one argument containing for each facet the value of the faceting variable. +#' +#' @return A [vchart()] `htmlwidget` object. +#' @export +#' +#' @importFrom rlang quos syms +#' +#' @example examples/facet_wrap.R +v_facet_wrap <- function(vc, + facets, + nrow = NULL, + ncol = NULL, + scales = c("fixed", "free", "free_y", "free_x"), + labeller = label_value) { + stopifnot( + "\'vc\' must be a chart constructed with vchart()" = inherits(vc, "vchart") + ) + scales <- match.arg(scales) + if (is.character(facets)) + facets <- quos(!!!syms(facets)) + data <- get_data(vc, NULL) + facets_values <- get_facets_values(data, facets) + n <- length(unique(facets_values$facet_id)) + dims <- get_facets_dims(n, nrow = nrow, ncol = ncol) + mat <- matrix( + data = seq_len(n)[seq_len(dims$nrow * dims$ncol)], + nrow = dims$nrow, + ncol = dims$ncol, + byrow = TRUE + ) + vc$x$specs$layout <- create_layout(dims$ncol, dims$nrow, title = !is.null(vc$title)) + vc$x$specs$region <- create_region(n) + vc$x$specs$indicator <- create_indicator(facets_values, label_fun = labeller) + vc$x$specs$data <- create_facet_data(vc, facet = facets_values) + vc$x$specs$series <- create_facet_series(vc, facet = facets_values) + x <- get_aes_data(vc$x$mapdata, c("x", "xmin", "xmax")) + y <- get_aes_data(vc$x$mapdata, c("y", "ymin", "ymax")) + vc$x$specs$axes <- c( + create_axis_x(vc, x = x, facet = facets_values, free = scales %in% c("free", "free_x"), last_row = get_last_row(mat)), + create_axis_y(vc, y = y, facet = facets_values, free = scales %in% c("free", "free_y"), first_col = mat[, 1]) + ) + return(vc) +} + -create_layout <- function(ncol, nrow) { +create_layout <- function(ncol, nrow, title = FALSE) { + create_matrix <- function(data, byrow) { matrix(data = data, nrow = nrow, ncol = ncol, byrow = byrow) } - + n <- ncol * nrow - + mat <- matrix(data = seq_len(n), nrow = nrow, ncol = ncol, byrow = TRUE) mat_axe_y_col <- create_matrix(rep(0 + ((seq_len(ncol) - 1) * 2), rep = nrow), TRUE) - mat_axe_y_row <- create_matrix(rep(1 + ((seq_len(nrow) - 1) * 3), rep = ncol), FALSE) + mat_axe_y_row <- create_matrix(rep(1 + ((seq_len(nrow) - 1) * 3), rep = ncol), FALSE) + title mat_axe_x_col <- create_matrix(rep(1 + ((seq_len(ncol) - 1) * 2), rep = nrow), TRUE) - mat_axe_x_row <- create_matrix(rep(2 + ((seq_len(nrow) - 1) * 3), rep = ncol), FALSE) + mat_axe_x_row <- create_matrix(rep(2 + ((seq_len(nrow) - 1) * 3), rep = ncol), FALSE) + title mat_chart_col <- create_matrix(rep(1 + ((seq_len(ncol) - 1) * 2), rep = nrow), TRUE) - mat_chart_row <- create_matrix(rep(1 + ((seq_len(nrow) - 1) * 3), rep = ncol), FALSE) + mat_chart_row <- create_matrix(rep(1 + ((seq_len(nrow) - 1) * 3), rep = ncol), FALSE) + title mat_ind_col <- create_matrix(rep(0 + ((seq_len(ncol) - 1) * 2), rep = nrow), TRUE) - mat_ind_row <- create_matrix(rep(0 + ((seq_len(nrow) - 1) * 3), rep = ncol), FALSE) - + mat_ind_row <- create_matrix(rep(0 + ((seq_len(nrow) - 1) * 3), rep = ncol), FALSE) + title + list( type = "grid", col = ncol * 2, - row = nrow * 3, + row = nrow * 3 + title, rowHeight = lapply( - X = 0 + (seq_len(nrow) - 1) * 3, + X = title + (seq_len(nrow) - 1) * 3, FUN = function(index) { list(index = index, size = 30) } ), elements = c( + if (title) { + list(list(modelId = "title", col = 0, row = 0, colSpan = ncol * 2)) + }, lapply( X = seq_len(n), FUN = function(num) { @@ -87,9 +145,7 @@ create_layout <- function(ncol, nrow) { } -create_region <- function(ncol, nrow) { - mat <- matrix(data = seq_len(ncol * nrow), nrow = nrow, ncol = ncol, byrow = TRUE) - n <- length(mat) +create_region <- function(n) { c( lapply( X = seq_len(n), @@ -111,13 +167,13 @@ create_facet_data <- function(vc, facet) { list_data <- lapply( X = seq_along(vc$x$specs$data), FUN = function(i) { - split_data <- split(vc$x$specs$data[[i]]$values, f = as.character(facet)) + split_data <- split(vc$x$specs$data[[i]]$values, f = facet$facet_id) lapply( X = seq_along(split_data), FUN = function(ii) { list( id = paste0("data_", ii, "_", i), - name = names(split_data)[ii], + name = get_facet_name(facet, names(split_data)[ii]), values = split_data[[ii]] ) } @@ -130,18 +186,17 @@ create_facet_data <- function(vc, facet) { create_facet_series <- function(vc, facet) { - facets <- unique(as.character(facet)) list_data <- lapply( - X = seq_along(facets), - FUN = function(i) { + X = unique(facet$facet_id), + FUN = function(id) { serie <- vc$x$specs$series lapply( X = seq_along(serie), - FUN = function(ii) { - this <- serie[[ii]] - this$id <- paste0("serie_", i, "_", ii) - this$dataId <- paste0("data_", i, "_", ii) - this$regionId <- paste0("chart_", i) + FUN = function(i) { + this <- serie[[i]] + this$id <- paste0("serie_", id, "_", i) + this$dataId <- paste0("data_", id, "_", i) + this$regionId <- paste0("chart_", id) return(this) } ) @@ -151,35 +206,130 @@ create_facet_series <- function(vc, facet) { } -create_indicator <- function(facet, label_fun = identity) { - values <- unique(facet) +create_indicator <- function(facet, label_fun = ggplot2::label_value) { lapply( - X = seq_along(values), - FUN = function(i) { - value <- label_fun(values[i]) - regionId <- paste0("indicator_", i) - if (is.null(value) || is.na(value)) { + X = unique(facet$facet_id), + FUN = function(id) { + value <- get_facet_name(facet, id, use_names = TRUE) + value <- label_fun(value) + regionId <- paste0("indicator_", id) + if (is.null(value) || all(is.na(value))) { return(list(regionId = regionId, visible = FALSE)) } - if (is.character(value)) { - return(list( - regionId = regionId, - visible = TRUE, - title = list( - style = list( - text = value, - textAlign = "center", - fontSize = 16 - ) - ) - )) - } list( regionId = regionId, visible = TRUE, - title = list(style = value) + content = list( + style = list( + text = unname(value), + textAlign = "center", + fontSize = 16 + ) + ) ) } ) } + + +create_axis_x <- function(vc, x, facet, free = TRUE, last_row = numeric(0)) { + index <- get_axes_index(vc, position = "bottom") + axe_x <- vc$x$specs$axes[[index]] + lapply( + X = unique(facet$facet_id), + FUN = function(id) { + this <- axe_x + this$id <- paste0("axe_x_", id) + this$regionId <- paste0("chart_", id) + if (identical(this$type, "linear") & isFALSE(free)) { + valrange <- scales::expand_range( + range = range(x, na.rm = TRUE), + mul = 0.05, + add = 0 + ) + this$softMin <- valrange[1] + this$softMax <- valrange[2] + } + this$label$visible <- isTRUE(free) | id %in% last_row + this$domainLine$visible <- isTRUE(free) | id %in% last_row + this$minHeight <- ifelse(isTRUE(free), 30, 20) + return(this) + } + ) +} + + + + +create_axis_y <- function(vc, y, facet, free = TRUE, first_col = numeric(0)) { + index <- get_axes_index(vc, position = "left") + axe_y <- vc$x$specs$axes[[index]] + lapply( + X = unique(facet$facet_id), + FUN = function(id) { + this <- axe_y + this$id <- paste0("axe_y_", id) + this$regionId <- paste0("chart_", id) + if (identical(this$type, "linear") & isFALSE(free)) { + valrange <- scales::expand_range( + range = range(y, na.rm = TRUE), + mul = 0.05, + add = 0 + ) + this$softMin <- valrange[1] + this$softMax <- valrange[2] + } + this$label$visible <- isTRUE(free) | id %in% first_col + this$domainLine$visible <- isTRUE(free) | id %in% first_col + this$minWidth <- ifelse(isTRUE(free), 35, 20) + return(this) + } + ) +} + + + +get_facets_dims <- function(n, nrow = NULL, ncol = NULL) { + if (is.null(nrow) & !is.null(ncol)) + nrow <- ceiling(n / ncol) + if (!is.null(nrow) & is.null(ncol)) + ncol <- ceiling(n / nrow) + if (is.null(nrow) & is.null(ncol)) { + if (n %% 3 < 1) { + ncol <- 3 + nrow <- ceiling(n / ncol) + } else { + ncol <- 2 + nrow <- ceiling(n / ncol) + } + } + list(nrow = nrow, ncol = ncol) +} + + +#' @importFrom rlang as_label +get_facets_values <- function(data, facets) { + all_values <- eval_mapping_(data, facets) + all_values <- as.data.frame(all_values, col.names = lapply(facets, as_label)) + # all_values <- all_values[do.call(order, unname(all_values)), , drop = FALSE] + unique_values <- unique(all_values) + unique_values$facet_id <- seq_along(unique_values[[1]]) + merge(x = all_values, y = unique_values, sort = FALSE) +} + +#' @importFrom utils head +get_facet_name <- function(facet, id, use_names = FALSE) { + unlist(head(facet[facet$facet_id == id, -ncol(facet)], 1), use.names = use_names) +} + + + +get_last_row <- function(mat) { + apply(X = mat, MARGIN = 2, FUN = function(x) { + x <- x[!is.na(x)] + x[length(x)] + }) +} + + diff --git a/R/layers.R b/R/layers.R index 6b124c6..16ce7a4 100644 --- a/R/layers.R +++ b/R/layers.R @@ -187,6 +187,7 @@ v_line <- function(vc, #' @export #' #' @importFrom rlang sym exec +#' @importFrom ggplot2 ggplot geom_smooth scale_color_identity layer_data #' #' @example examples/v_smooth.R v_smooth <- function(vc, @@ -206,18 +207,18 @@ v_smooth <- function(vc, ) data <- get_data(vc, data) mapping <- get_mapping(vc, mapping) - p <- ggplot2::ggplot(data = data, mapping = mapping) - p <- p + ggplot2::geom_smooth( - method = method, - formula = formula, - se = se, - n = n, - span = span - ) + - ggplot2::scale_color_identity() - mapdata <- ggplot2::layer_data(p, i = 1L) - # vc$x$mapdata <- c(vc$x$mapdata, as.list(mapdata)) - # vc$x$type <- c(vc$x$type, "smooth") + p <- ggplot(data = data, mapping = mapping) + + geom_smooth( + method = method, + formula = formula, + se = se, + n = n, + span = span + ) + + scale_color_identity() + mapdata <- layer_data(p, i = 1L) + vc$x$mapdata <- c(vc$x$mapdata, list(as.list(mapdata))) + vc$x$type <- c(vc$x$type, "smooth") vc$x$mapping <- NULL if (is.null(dataserie_id)) dataserie_id <- paste0("serie_", genId(4)) @@ -329,7 +330,7 @@ v_area <- function(vc, ... ) vc <- .vchart_specs(vc, "series", list(serie)) - + scale_x <- attr(mapdata, "scale_x") if (identical(scale_x, "discrete")) { vc <- v_scale_x_discrete(vc) @@ -473,7 +474,7 @@ v_scatter <- function(vc, if (identical(mapping$colour, mapping$shape)) shapeField <- "colour" shape <- if (!is.null(shapeField)) - list(type = "ordinal") + list(type = "ordinal") serie <- list_( type = "scatter", id = dataserie_id, @@ -501,7 +502,7 @@ v_scatter <- function(vc, ) vc <- .vchart_specs( vc, "crosshair", - list( + list( xField = list( visible = TRUE, line = list(visible = TRUE, type= "line"), @@ -536,12 +537,12 @@ v_scatter <- function(vc, #' #' @return A [vchart()] `htmlwidget` object. #' @export -#' +#' #' @importFrom rlang syms set_names #' @importFrom ggplot2 ggplot geom_jitter scale_color_identity layer_data layer_scales #' #' @example examples/v_jitter.R -v_jitter <- function(vc, +v_jitter <- function(vc, mapping = NULL, data = NULL, name = NULL, @@ -555,7 +556,7 @@ v_jitter <- function(vc, data <- get_data(vc, data) mapping <- get_mapping(vc, mapping) mapdata <- eval_mapping_(data, mapping) - p <- ggplot(data = data, mapping = mapping) + + p <- ggplot(data = data, mapping = mapping) + geom_jitter(width = width, height = height) + scale_color_identity() ldata <- layer_data(p, i = 1L) @@ -569,8 +570,8 @@ v_jitter <- function(vc, ) if (identical(attr(mapdata, "scale_x"), "discrete")) { vc <- v_scale_x_continuous( - vc, - zero = FALSE, + vc, + zero = FALSE, softMin = 0, softMax = max(ldata$group) + 1, breaks = ldata$group, @@ -1064,7 +1065,7 @@ v_sankey <- function(vc, name <- rlang::as_label(mapping$word) if (is.null(dataserie_id)) dataserie_id <- paste0("serie_", genId(4)) - + specs <- list( type = "sankey", label = list( @@ -1073,9 +1074,9 @@ v_sankey <- function(vc, ), ... ) - + mapdata <- NULL - + if (!is.null(data) & length(mapping) > 0) { if (has_name(mapping, "lvl1") & has_name(mapping, "value")) { mapdata <- eval_mapping(data, mapping) @@ -1283,7 +1284,7 @@ v_progress <- function(vc, #' #' @return A [vchart()] `htmlwidget` object. #' @export -#' +#' #' @importFrom rlang exec set_names #' @importFrom ggplot2 ggplot geom_boxplot scale_color_identity layer_data layer_scales #' @@ -1335,7 +1336,7 @@ v_boxplot <- function(vc, ) ) boxPlot <- args$boxPlot %||% list() - # boxPlot$style$boxWidth <- boxPlot$style$boxWidth %||% + # boxPlot$style$boxWidth <- boxPlot$style$boxWidth %||% # JS(sprintf("(datum, ctx) => { console.log(ctx); return ctx.getRegion().getLayoutRect().width / %s; }", max(c(6, nrow(mapdata) * 2)))) boxPlot$style$boxWidth <- boxPlot$style$boxWidth %||% JS(sprintf("(datum, ctx) => { return ctx.valueToX(%s); }", mapdata$xmax[1] - mapdata$xmin[1])) @@ -1361,8 +1362,8 @@ v_boxplot <- function(vc, vc <- .vchart_specs(vc, "series", list(serie)) pscales <- layer_scales(p) vc <- v_scale_x_continuous( - vc, - zero = FALSE, + vc, + zero = FALSE, softMin = 0, softMax = max(mapdata$x) + 1, tick = list( @@ -1381,10 +1382,9 @@ v_boxplot <- function(vc, ) ) vc <- v_scale_y_continuous( - vc, + vc, zero = FALSE, range = set_names(as.list(pscales$y$get_limits()), c("min", "max")) ) return(vc) } - diff --git a/examples/dev-facet.R b/examples/dev-facet.R index f5c29a2..6cdc741 100644 --- a/examples/dev-facet.R +++ b/examples/dev-facet.R @@ -1,16 +1,46 @@ + pkgload::load_all() -str(.Last.value$x$specs) library(dplyr) library(ggplot2) +library(rlang) + +str(.Last.value$x$specs) + vc <- vchart(mpg) %>% v_scatter(aes(displ, cty)) -vc$x$specs$series +vc$x$specs$axes + + +mat <- matrix(data = seq_len(2 * 2), nrow = 2, ncol = 2, byrow = TRUE) + +create_axis_x(vc, x = mpg %>% pull(displ), facet = mpg$cyl, free = FALSE, last_row = c(3, 4)) + + +facets_values <- get_facets_values(mpg, vars(cyl)) +create_indicator(facets_values, label_fun = ggplot2::label_value) + +ggplot2::label_value(c(8, "totot"), multi_line = TRUE) + +vc <- vchart(mpg) %>% + v_scatter(aes(displ, cty)) %>% + v_facet_wrap(vars(cyl)) + -split(vc$x$specs$data[[1]]$values, f = as.character(mpg$cyl))[[2]] +vchart(mpg) %>% + v_scatter(aes(displ, cty)) %>% + v_facet_wrap(vars(cyl, year)) + + + +vc$x$specs$indicator + +ggplot(mpg) + + geom_point(aes(displ, cty)) + + facet_wrap(vars(cyl), scales = "fixed") str(create_layout(2, 2)) @@ -20,121 +50,29 @@ create_facet_series(vc, facet = as.character(mpg$cyl)) vchart( type = "common", - layout = create_layout(2, 2), + # title = list(text = "Title", id = "title"), + layout = create_layout(2, 2, title = FALSE), region = create_region(2, 2), indicator = create_indicator(as.character(mpg$cyl)), data = create_facet_data(vc, facet = as.character(mpg$cyl)), series = create_facet_series(vc, facet = as.character(mpg$cyl)), - axes = list( - list( - id = "axe_y_1", - orient = "left", - regionId = paste0("chart_", 1), - type = "linear", - domainLine = list(visible = TRUE), - zero = FALSE, - # seriesId = paste0("serie_", 1:4), - softMin = mpg %>% select(x = displ, y = cty) %>% pull(y) %>% min(na.rm = TRUE), - softMax = mpg %>% select(x = displ, y = cty) %>% pull(y) %>% max(na.rm = TRUE), - expand = list(min = 0.2, max = 0.2), - minWidth = 20 - ), - list( - id = "axe_y_2", - orient = "left", - regionId = paste0("chart_", 2), - type = "linear", - label = list(visible = FALSE), - domainLine = list(visible = FALSE), - zero = FALSE, - # seriesId = paste0("serie_", 1:4), - softMin = mpg %>% select(x = displ, y = cty) %>% pull(y) %>% min(na.rm = TRUE), - softMax = mpg %>% select(x = displ, y = cty) %>% pull(y) %>% max(na.rm = TRUE), - expand = list(min = 0.2, max = 0.2), - minWidth = 20 - ), - list( - id = "axe_y_3", - orient = "left", - regionId = paste0("chart_", 3), - type = "linear", - domainLine = list(visible = TRUE), - zero = FALSE, - # seriesId = paste0("serie_", 1:4), - softMin = mpg %>% select(x = displ, y = cty) %>% pull(y) %>% min(na.rm = TRUE), - softMax = mpg %>% select(x = displ, y = cty) %>% pull(y) %>% max(na.rm = TRUE), - expand = list(min = 0.2, max = 0.2), - minWidth = 20 - ), - list( - id = "axe_y_4", - orient = "left", - regionId = paste0("chart_", 4), - type = "linear", - label = list(visible = FALSE), - domainLine = list(visible = FALSE), - zero = FALSE, - # seriesId = paste0("serie_", 1:4), - softMin = mpg %>% select(x = displ, y = cty) %>% pull(y) %>% min(na.rm = TRUE), - softMax = mpg %>% select(x = displ, y = cty) %>% pull(y) %>% max(na.rm = TRUE), - expand = list(min = 0.2, max = 0.2), - minWidth = 20 - ), - list( - id = "axe_x_1", - orient = "bottom", - regionId = paste0("chart_", 1), - type = "linear", - visible = TRUE, - label = list(visible = FALSE), - domainLine = list(visible = FALSE), - zero = FALSE, - # seriesId = paste0("serie_", 1:4), - softMin = mpg %>% select(x = displ, y = cty) %>% pull(x) %>% min(na.rm = TRUE), - softMax = mpg %>% select(x = displ, y = cty) %>% pull(x) %>% max(na.rm = TRUE), - expand = list(min = 0.2, max = 0.2), - minHeight = 20 - ), - list( - id = "axe_x_2", - orient = "bottom", - regionId = paste0("chart_", 2), - type = "linear", - visible = TRUE, - label = list(visible = FALSE), - domainLine = list(visible = FALSE), - zero = FALSE, - # seriesId = paste0("serie_", 1:4), - softMin = mpg %>% select(x = displ, y = cty) %>% pull(x) %>% min(na.rm = TRUE), - softMax = mpg %>% select(x = displ, y = cty) %>% pull(x) %>% max(na.rm = TRUE), - expand = list(min = 0.2, max = 0.2), - minHeight = 20 - ), - list( - id = "axe_x_3", - orient = "bottom", - regionId = paste0("chart_", 3), - type = "linear", - domainLine = list(visible = TRUE), - zero = FALSE, - # seriesId = paste0("serie_", 1:4), - softMin = mpg %>% select(x = displ, y = cty) %>% pull(x) %>% min(na.rm = TRUE), - softMax = mpg %>% select(x = displ, y = cty) %>% pull(x) %>% max(na.rm = TRUE), - expand = list(min = 0.2, max = 0.2), - minHeight = 20 - ), - list( - id = "axe_x_4", - orient = "bottom", - regionId = paste0("chart_", 4), - type = "linear", - domainLine = list(visible = TRUE), - zero = FALSE, - # seriesId = paste0("serie_", 1:4), - softMin = mpg %>% select(x = displ, y = cty) %>% pull(x) %>% min(na.rm = TRUE), - softMax = mpg %>% select(x = displ, y = cty) %>% pull(x) %>% max(na.rm = TRUE), - expand = list(min = 0.2, max = 0.2), - minHeight = 20 - ) + axes = c( + create_axis_x(vc, x = mpg %>% pull(displ), facet = mpg$cyl, free = TRUE, last_row = c(3, 4)), + create_axis_y(vc, y = mpg %>% pull(cty), facet = mpg$cyl, free = TRUE, first_col = c(1, 3)) ) ) + + +facets <- eval_mapping_(mpg, vars(year, drv)) +unique(as.data.frame(facets, col.names = lapply(vars(year, drv), as_label))) + + +n_facet(facets) + +get_facets_dims(6) + + +get_facets_values(mpg, vars(year, drv)) + +split(mpg, f = get_facets_values(mpg, vars(year, drv))$facet_id) + diff --git a/examples/facet_wrap.R b/examples/facet_wrap.R new file mode 100644 index 0000000..28e08dd --- /dev/null +++ b/examples/facet_wrap.R @@ -0,0 +1,35 @@ +library(vchartr) +library(ggplot2) + +# Use vars() to supply faceting variables: +vchart(mpg) %>% + v_scatter(aes(displ, hwy)) %>% + v_facet_wrap(vars(class)) + +# Control the number of rows and columns with nrow and ncol +vchart(mpg) %>% + v_scatter(aes(displ, hwy)) %>% + v_facet_wrap(vars(class), ncol = 3) + +# You can facet by multiple variables +vchart(mpg) %>% + v_scatter(aes(displ, hwy)) %>% + v_facet_wrap(vars(cyl, drv)) + +# Use the `labeller` option to control how labels are printed: +vchart(mpg) %>% + v_scatter(aes(displ, hwy)) %>% + v_facet_wrap(vars(cyl, drv), labeller = label_both) + +# To change the order in which the panels appear, change the levels +# of the underlying factor. +mpg$class2 <- reorder(mpg$class, mpg$displ) +vchart(mpg) %>% + v_scatter(aes(displ, hwy)) %>% + v_facet_wrap(vars(class2), ncol = 3) + +# By default, the same scales are used for all panels. You can allow +# scales to vary across the panels with the `scales` argument. +vchart(mpg) %>% + v_scatter(aes(displ, hwy)) %>% + v_facet_wrap(vars(class), scales = "free") diff --git a/man/v_facet_wrap.Rd b/man/v_facet_wrap.Rd new file mode 100644 index 0000000..bb0af6c --- /dev/null +++ b/man/v_facet_wrap.Rd @@ -0,0 +1,71 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/facets.R +\name{v_facet_wrap} +\alias{v_facet_wrap} +\title{Facets for vchart} +\usage{ +v_facet_wrap( + vc, + facets, + nrow = NULL, + ncol = NULL, + scales = c("fixed", "free", "free_y", "free_x"), + labeller = label_value +) +} +\arguments{ +\item{vc}{A chart initialized with \code{\link[=vchart]{vchart()}}.} + +\item{facets}{Variable(s) to use for facetting, wrapped in \code{vars(...)}.} + +\item{nrow, ncol}{Number of row and column in output matrix.} + +\item{scales}{Should scales be fixed (\code{"fixed"}, the default), +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.} +} +\value{ +A \code{\link[=vchart]{vchart()}} \code{htmlwidget} object. +} +\description{ +Create matrix of charts by row and column faceting variable (\code{v_facet_grid}), +or by specified number of row and column for faceting variable(s) (\code{v_facet_wrap}). +} +\examples{ +library(vchartr) +library(ggplot2) + +# Use vars() to supply faceting variables: +vchart(mpg) \%>\% + v_scatter(aes(displ, hwy)) \%>\% + v_facet_wrap(vars(class)) + +# Control the number of rows and columns with nrow and ncol +vchart(mpg) \%>\% + v_scatter(aes(displ, hwy)) \%>\% + v_facet_wrap(vars(class), ncol = 3) + +# You can facet by multiple variables +vchart(mpg) \%>\% + v_scatter(aes(displ, hwy)) \%>\% + v_facet_wrap(vars(cyl, drv)) + +# Use the `labeller` option to control how labels are printed: +vchart(mpg) \%>\% + v_scatter(aes(displ, hwy)) \%>\% + v_facet_wrap(vars(cyl, drv), labeller = label_both) + +# To change the order in which the panels appear, change the levels +# of the underlying factor. +mpg$class2 <- reorder(mpg$class, mpg$displ) +vchart(mpg) \%>\% + v_scatter(aes(displ, hwy)) \%>\% + v_facet_wrap(vars(class2), ncol = 3) + +# By default, the same scales are used for all panels. You can allow +# scales to vary across the panels with the `scales` argument. +vchart(mpg) \%>\% + v_scatter(aes(displ, hwy)) \%>\% + v_facet_wrap(vars(class), scales = "free") +}