diff --git a/DESCRIPTION b/DESCRIPTION
index 7b8d89d..09069f0 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -15,6 +15,7 @@ BugReports: https://github.com/mikmart/ggragged/issues
Depends:
ggplot2
Imports:
+ grid,
gtable,
rlang,
vctrs
@@ -24,6 +25,7 @@ Suggests:
nlme,
ragg,
rmarkdown,
+ roxygen2,
testthat (>= 3.0.0),
vdiffr
VignetteBuilder:
@@ -31,7 +33,7 @@ VignetteBuilder:
Config/testthat/edition: 3
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
Collate:
'facet_ragged.R'
'facet_ragged_rows.R'
@@ -40,4 +42,3 @@ Collate:
'grid.R'
'gtable.R'
'layout.R'
- 'utils.R'
diff --git a/NEWS.md b/NEWS.md
index 0243c05..01914d4 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -3,6 +3,10 @@
* Added a vignette showing examples of usage in broader context.
* Fixed an issue that caused the package to fail to build (with an "argument is
missing" error message) when an older version of ggplot2 was installed.
+* Added new parameters `strips` and `axes` to facets that control whether strips
+ and axes respectively are drawn between adjacent panels.
+* Fixed an issue that caused some axes to be rendered incorrectly when using
+ free scales with `coord_flip()` (#2).
# ggragged 0.1.0
diff --git a/R/facet_ragged.R b/R/facet_ragged.R
index 601980d..c2eb7b4 100644
--- a/R/facet_ragged.R
+++ b/R/facet_ragged.R
@@ -7,14 +7,22 @@
#' nested or partially crossed relationships between faceting variables.
#'
#' @param rows,cols A set of variables or expressions quoted by [ggplot2::vars()],
-#' the combinations of which define panels to be included in the grid.
+#' the combinations of which define the panels to be included in the layout.
#' @param ... Arguments reserved for future use.
-#' @param scales Should all panels share the same scales (`"fixed"`),
-#' x-axes vary (`"free_x"`), y-axes vary (`"free_y"`), or both (`"free"`)?
-#' Panels within groups always share the scale along the grouping dimension.
-#' @param switch By default, facet labels are positioned to the top and right
-#' of the panels. Use `"x"` to switch the top strip to the bottom,
-#' use `"y"` to switch the right strip to the left, or `"both"`.
+#' @param scales Should all panels share the same scales (`"fixed"`), x-axes
+#' vary (`"free_x"`), y-axes vary (`"free_y"`), or both (`"free"`)? Panels
+#' within groups always share the scale along the grouping dimension.
+#' @param switch Determines how facet label strips are positioned. By default
+#' (`"none"`), strips are drawn to the top and right of the panels. Use `"x"`
+#' to switch the top strip to the bottom, use `"y"` to switch the right strip
+#' to the left, or `"both"` to do both.
+#' @param strips Determines which facet label strips are drawn. By default
+#' (`"margins"`), strips between panels along the grouping dimension will be
+#' suppressed. Use `"all"` to always draw both strips.
+#' @param axes Determines which axes are drawn. By default (`"margins"`), axes
+#' between panels will be suppressed if they are fixed. Use `"all_x"` to
+#' always draw x-axes, `"all_y"` to always draw y-axes, or `"all"` to always
+#' draw both axes.
#' @inheritParams ggplot2::facet_wrap
#'
#' @returns A `Facet` that can be added to a `ggplot`.
@@ -57,36 +65,219 @@ NULL
FacetRagged <- ggproto("FacetRagged", Facet,
shrink = TRUE,
+ setup_params = function(data, params) {
+ params <- Facet$setup_params(data, params)
+ params$rows <- rlang::quos_auto_name(params$rows)
+ params$cols <- rlang::quos_auto_name(params$cols)
+ params$free <- list(
+ x = params$scales %in% c("free_x", "free"),
+ y = params$scales %in% c("free_y", "free")
+ )
+ params$switch <- list(
+ x = params$switch %in% c("x", "both"),
+ y = params$switch %in% c("y", "both")
+ )
+ params$axes <- list(
+ x = params$axes %in% c("all_x", "all"),
+ y = params$axes %in% c("all_y", "all")
+ )
+ params$strip.position <- c(
+ if (params$switch$x) "bottom" else "top",
+ if (params$switch$y) "left" else "right"
+ )
+ params
+ },
+
map_data = function(data, layout, params) {
FacetGrid$map_data(data, layout, params)
},
vars = function(self) {
names(c(self$params$rows, self$params$cols))
+ },
+
+ draw_panels = function(self, panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) {
+ table <- self$init_gtable(panels, layout, ranges, coord, theme, params)
+ table <- self$attach_axes(table, layout, ranges, coord, theme, params)
+ table <- self$attach_strips(table, layout, theme, params)
+ table
+ },
+
+ init_gtable = function(panels, layout, ranges, coord, theme, params) {
+ if (!coord$is_free() && (params$free$x || params$free$y))
+ stop("Can't use free scales with a fixed coordinate system.")
+ aspect_ratio <- theme$aspect.ratio %||% coord$aspect(ranges[[1]])
+
+ # Create an empty table with dimensions from layout
+ rows_count <- max(layout$ROW)
+ cols_count <- max(layout$COL)
+ widths <- rep(unit(1, "null"), cols_count)
+ heights <- rep(unit(aspect_ratio %||% 1, "null"), rows_count)
+ table <- gtable(widths, heights, respect = !is.null(aspect_ratio))
+
+ # Insert panel grobs according to layout and add spacing
+ panel_name <- sprintf("panel-%d", layout$PANEL)
+ table <- gtable_add_grob(table, panels, layout$ROW, layout$COL, name = panel_name)
+ table <- gtable_add_col_space(table, calc_element("panel.spacing.x", theme))
+ table <- gtable_add_row_space(table, calc_element("panel.spacing.y", theme))
+
+ table
+ },
+
+ attach_axes = function(table, layout, ranges, coord, theme, params) {
+ axes <- render_axes(ranges, ranges, coord, theme)
+ axes <- list(
+ t = lapply(axes$x, `[[`, "top"),
+ b = lapply(axes$x, `[[`, "bottom"),
+ l = lapply(axes$y, `[[`, "left"),
+ r = lapply(axes$y, `[[`, "right")
+ )
+ add_panel_decorations(table, layout, axes, kind = "axis")
+ },
+
+ attach_strips = function(table, layout, theme, params) {
+ # Render strips with faceting variable data
+ cols_data <- layout[names(params$cols)]
+ rows_data <- layout[names(params$rows)]
+ strips <- render_strips(cols_data, rows_data, params$labeller, theme)
+ strips <- c(strips$x, strips$y)
+
+ # Zero out strips which shouldn't be added
+ for (side in c("top", "bottom", "left", "right"))
+ if (!side %in% params$strip.position)
+ strips[[side]][] <- list(zeroGrob())
+
+ # Make strips stick correctly in zero-sized rows/cols
+ for (side in c("top", "bottom", "left", "right"))
+ strips[[side]] <- lapply(strips[[side]], set_strip_viewport, side)
+
+ add_panel_decorations(table, layout, strips, kind = "strip")
}
)
-new_facet_ragged <- function(parent, rows, cols, ..., scales, switch, labeller) {
- rlang::check_dots_empty()
-
- scales <- rlang::arg_match0(scales, c("fixed", "free_x", "free_y", "free"))
- switch <- if (!is.null(switch)) rlang::arg_match0(switch, c("x", "y", "both")) else "none"
-
- ggproto(
- NULL,
- parent,
- params = list(
- rows = rlang::quos_auto_name(rows),
- cols = rlang::quos_auto_name(cols),
- free = list(
- x = scales %in% c("free_x", "free"),
- y = scales %in% c("free_y", "free")
- ),
- switch = list(
- x = switch %in% c("x", "both"),
- y = switch %in% c("y", "both")
- ),
- labeller = labeller
+add_panel_decorations <- function(table, layout, grobs, kind) {
+ kind <- rlang::arg_match0(kind, c("axis", "strip"))
+
+ # Add rows for horizontal decorations
+ for (t in rev(panel_rows(table)$t)) {
+ table <- gtable_add_rows(table, max_height(grobs$t), t - 1)
+ table <- gtable_add_rows(table, max_height(grobs$b), t + 1)
+ }
+
+ # Add columns for vertical decorations
+ for (l in rev(panel_cols(table)$l)) {
+ table <- gtable_add_cols(table, max_width(grobs$l), l - 1)
+ table <- gtable_add_cols(table, max_width(grobs$r), l + 1)
+ }
+
+ # Find panel positions after layout changes
+ panel_rows_pos <- panel_rows(table)
+ panel_cols_pos <- panel_cols(table)
+
+ t <- panel_rows_pos$t[layout$ROW] - 1
+ b <- panel_rows_pos$b[layout$ROW] + 1
+ l <- panel_cols_pos$l[layout$COL] - 1
+ r <- panel_cols_pos$r[layout$COL] + 1
+
+ # Add decorations around panels
+ table <- gtable_add_grob(table, grobs$t, t, l + 1, name = sprintf("%s-t-%d", kind, layout$PANEL))
+ table <- gtable_add_grob(table, grobs$b, b, l + 1, name = sprintf("%s-b-%d", kind, layout$PANEL))
+ table <- gtable_add_grob(table, grobs$l, t + 1, l, name = sprintf("%s-l-%d", kind, layout$PANEL))
+ table <- gtable_add_grob(table, grobs$r, t + 1, r, name = sprintf("%s-r-%d", kind, layout$PANEL))
+
+ table
+}
+
+set_strip_viewport <- function(strip, side) {
+ strip$vp <- switch(
+ substr(side, 1, 1),
+ # TODO: `clip = "off"` not needed in ggplot2 dev version (3.5.1.9000), could be removed in the future.
+ t = grid::viewport(clip = "off", height = grid::grobHeight(strip), y = unit(0, "npc"), just = "bottom"),
+ b = grid::viewport(clip = "off", height = grid::grobHeight(strip), y = unit(1, "npc"), just = "top"),
+ l = grid::viewport(clip = "off", width = grid::grobWidth(strip), x = unit(1, "npc"), just = "right"),
+ r = grid::viewport(clip = "off", width = grid::grobWidth(strip), x = unit(0, "npc"), just = "left"),
+ stop("internal error: invalid side: ", side)
+ )
+ strip
+}
+
+cull_inner_panel_decorations <- function(table, layout, sides, kind) {
+ kind <- rlang::arg_match0(kind, c("axis", "strip"))
+ for (side in sides) {
+ # Remove grobs from inner panels
+ panels <- panels_with_neighbour(layout, side)
+ names <- sprintf("%s-%s-%d", kind, side, panels)
+ table <- gtable_set_grobs(table, names, list(zeroGrob()))
+
+ # And the space allocated for them
+ table <- switch(
+ side,
+ t = ,
+ b = gtable_set_height(table, names, unit(0, "cm")),
+ l = ,
+ r = gtable_set_width(table, names, unit(0, "cm")),
+ stop("internal error: invalid side: ", side)
)
+
+ # Shift axes at inner margins to start at strip edge. It would be much
+ # cleaner to have the axes attached to the strips, but that doesn't play
+ # nicely with how ggplot2 expects the axes to be present in the gtable.
+ if (kind == "strip")
+ table <- shift_inner_margin_axes(table, layout, side)
+ }
+ table
+}
+
+panels_with_neighbour <- function(layout, side) {
+ neighbour <- switch(
+ side,
+ t = list(PANEL = layout$PANEL, ROW = layout$ROW - 1, COL = layout$COL),
+ b = list(PANEL = layout$PANEL, ROW = layout$ROW + 1, COL = layout$COL),
+ l = list(PANEL = layout$PANEL, ROW = layout$ROW, COL = layout$COL - 1),
+ r = list(PANEL = layout$PANEL, ROW = layout$ROW, COL = layout$COL + 1),
+ stop("internal error: invalid side: ", side)
+ )
+ merge(layout[c("ROW", "COL")], neighbour)$PANEL
+}
+
+margin_panels <- function(layout, side) {
+ setdiff(layout$PANEL, panels_with_neighbour(layout, side))
+}
+
+shift_inner_margin_axes <- function(table, layout, side) {
+ for (panel in margin_panels(layout, side)) {
+ if (is_panel_on_outer_margin(layout, panel, side)) next
+
+ # Get the strip and axis, bailing if either isn't there
+ strip_name <- sprintf("strip-%s-%d", side, panel)
+ strip <- gtable_get_grob(table, strip_name)
+ if (is.null(strip) || inherits(strip, "zeroGrob")) next
+
+ axis_name <- sprintf("axis-%s-%d", side, panel)
+ axis <- gtable_get_grob(table, axis_name)
+ if (is.null(axis) || inherits(axis, "zeroGrob")) next
+
+ # Shift the axis to start at the edge of the strip
+ axis <- switch(
+ side,
+ t = grob_shift_viewport(axis, y = +grid::grobHeight(strip)),
+ b = grob_shift_viewport(axis, y = -grid::grobHeight(strip)),
+ l = grob_shift_viewport(axis, x = -grid::grobWidth(strip)),
+ r = grob_shift_viewport(axis, x = +grid::grobWidth(strip)),
+ stop("internal error: invalid side: ", side)
+ )
+ table <- gtable_set_grobs(table, axis_name, list(axis))
+ }
+ table
+}
+
+is_panel_on_outer_margin <- function(layout, panel, side) {
+ switch(
+ side,
+ t = layout[match(panel, layout$PANEL), "ROW"] == min(layout$ROW),
+ b = layout[match(panel, layout$PANEL), "ROW"] == max(layout$ROW),
+ l = layout[match(panel, layout$PANEL), "COL"] == min(layout$COL),
+ r = layout[match(panel, layout$PANEL), "COL"] == max(layout$COL),
+ stop("internal error: invalid side: ", side)
)
}
diff --git a/R/facet_ragged_cols.R b/R/facet_ragged_cols.R
index ba96721..751c62b 100644
--- a/R/facet_ragged_cols.R
+++ b/R/facet_ragged_cols.R
@@ -1,21 +1,31 @@
#' @include facet_ragged_rows.R
#' @rdname facet_ragged
#' @export
-facet_ragged_cols <- function(rows, cols, ..., scales = "fixed", switch = NULL, labeller = "label_value") {
- new_facet_ragged(FacetRaggedCols, rows, cols, ..., scales = scales, switch = switch, labeller = labeller)
+facet_ragged_cols <- function(rows, cols, ..., scales = "fixed", switch = "none", strips = "margins", axes = "margins", labeller = "label_value") {
+ rlang::check_dots_empty()
+ switch <- switch %||% "none" # Compatibility with old default value NULL
+
+ scales <- rlang::arg_match0(scales, c("fixed", "free_x", "free_y", "free"))
+ switch <- rlang::arg_match0(switch, c("none", "x", "y", "both"))
+ strips <- rlang::arg_match0(strips, c("margins", "all"))
+ axes <- rlang::arg_match0(axes, c("margins", "all_x", "all_y", "all"))
+
+ ggproto(
+ NULL,
+ FacetRaggedCols,
+ params = list(
+ rows = rows,
+ cols = cols,
+ scales = scales,
+ switch = switch,
+ strips = strips,
+ axes = axes,
+ labeller = labeller
+ )
+ )
}
FacetRaggedCols <- ggproto("FacetRaggedCols", FacetRagged,
- setup_params = function(data, params) {
- params <- FacetRagged$setup_params(data, params)
-
- # Add parameters expected by FacetWrap
- params$strip.position <- if (params$switch$y) "left" else "right"
- params$facets <- params$rows
-
- params
- },
-
compute_layout = function(data, params) {
rows <- params$rows
cols <- params$cols
@@ -33,54 +43,24 @@ FacetRaggedCols <- ggproto("FacetRaggedCols", FacetRagged,
cbind(layout, panels)
},
- draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) {
- params$free$x <- FALSE # Always suppress intermediate axes in columns
- panel_table <- FacetWrap$draw_panels(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params)
+ attach_axes = function(table, layout, ranges, coord, theme, params) {
+ table <- FacetRagged$attach_axes(table, layout, ranges, coord, theme, params)
- # Render column strips that FacetWrap didn't know about
- strip_data <- vctrs::vec_unique(layout[names(params$cols)])
- strips <- render_strips(strip_data, NULL, params$labeller, theme)
+ if (!params$axes$x)
+ table <- cull_inner_panel_decorations(table, layout, sides = c("t", "b"), kind = "axis")
- panel_pos_rows <- panel_rows(panel_table)
- panel_pos_cols <- panel_cols(panel_table)
+ if (!params$axes$y && !params$free$y)
+ table <- cull_inner_panel_decorations(table, layout, sides = c("l", "r"), kind = "axis")
- strip_layout_col <- seq_len(max(layout$COL))
- strip_pos_l <- panel_pos_cols$r[strip_layout_col]
-
- if (params$switch$x) {
- # Add strips to the bottom of the panels on the last row in each column
- strip_name <- sprintf("strip-b-%d", strip_layout_col)
- strip_layout_row <- tapply(layout$ROW, layout$COL, max)
- strip_pos_t <- panel_pos_rows$b[strip_layout_row] + 1L
- strip_height <- max_height(strips$x$bottom)
-
- # Pad strips to start at the edge of the panel
- on_last_row <- strip_layout_row == max(strip_layout_row)
- strips$x$bottom <- iapply(strips$x$bottom, !on_last_row, function(strip) {
- if (!is.gtable(strip)) strip else gtable_add_rows(strip, strip_height, 0L)
- })
-
- # Shift axes to start at the edge of the strip
- row <- strip_layout_row[!on_last_row]
- col <- strip_layout_col[!on_last_row]
- axis_name <- sprintf("axis-b-%d-%d", col, row)
- axes <- gtable_get_grob(panel_table, axis_name)
- axes <- lapply(axes, grob_shift_viewport, y = -strip_height)
- panel_table <- gtable_set_grob(panel_table, axis_name, axes)
+ table
+ },
- panel_table <- gtable_add_rows(panel_table, strip_height, max(strip_pos_t) - 1L)
- panel_table <- gtable_add_grob(panel_table, strips$x$bottom, strip_pos_t, strip_pos_l, clip = "off", name = strip_name, z = 2)
- } else {
- # Add strips to the top of the panels on the first row
- strip_name <- sprintf("strip-t-%d", strip_layout_col)
- strip_layout_row <- rep(1L, length(strip_layout_col))
- strip_pos_t <- panel_pos_rows$t[strip_layout_row]
- strip_height <- max_height(strips$x$top)
+ attach_strips = function(table, layout, theme, params) {
+ table <- FacetRagged$attach_strips(table, layout, theme, params)
- panel_table <- gtable_add_rows(panel_table, strip_height, min(strip_pos_t) - 1L)
- panel_table <- gtable_add_grob(panel_table, strips$x$top, strip_pos_t, strip_pos_l, clip = "on", name = strip_name, z = 2)
- }
+ if (params$strips == "margins")
+ table <- cull_inner_panel_decorations(table, layout, sides = c("t", "b"), kind = "strip")
- panel_table
+ table
}
)
diff --git a/R/facet_ragged_rows.R b/R/facet_ragged_rows.R
index c97194f..8927e56 100644
--- a/R/facet_ragged_rows.R
+++ b/R/facet_ragged_rows.R
@@ -1,21 +1,31 @@
#' @include facet_ragged.R
#' @rdname facet_ragged
#' @export
-facet_ragged_rows <- function(rows, cols, ..., scales = "fixed", switch = NULL, labeller = "label_value") {
- new_facet_ragged(FacetRaggedRows, rows, cols, ..., scales = scales, switch = switch, labeller = labeller)
+facet_ragged_rows <- function(rows, cols, ..., scales = "fixed", switch = "none", strips = "margins", axes = "margins", labeller = "label_value") {
+ rlang::check_dots_empty()
+ switch <- switch %||% "none" # Compatibility with old default value NULL
+
+ scales <- rlang::arg_match0(scales, c("fixed", "free_x", "free_y", "free"))
+ switch <- rlang::arg_match0(switch, c("none", "x", "y", "both"))
+ strips <- rlang::arg_match0(strips, c("margins", "all"))
+ axes <- rlang::arg_match0(axes, c("margins", "all_x", "all_y", "all"))
+
+ ggproto(
+ NULL,
+ FacetRaggedRows,
+ params = list(
+ rows = rows,
+ cols = cols,
+ scales = scales,
+ switch = switch,
+ strips = strips,
+ axes = axes,
+ labeller = labeller
+ )
+ )
}
FacetRaggedRows <- ggproto("FacetRaggedRows", FacetRagged,
- setup_params = function(data, params) {
- params <- FacetRagged$setup_params(data, params)
-
- # Add parameters expected by FacetWrap
- params$strip.position <- if (params$switch$x) "bottom" else "top"
- params$facets <- params$cols
-
- params
- },
-
compute_layout = function(data, params) {
rows <- params$rows
cols <- params$cols
@@ -33,54 +43,24 @@ FacetRaggedRows <- ggproto("FacetRaggedRows", FacetRagged,
cbind(layout, panels)
},
- draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) {
- params$free$y <- FALSE # Always suppress intermediate axes on rows
- panel_table <- FacetWrap$draw_panels(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params)
+ attach_axes = function(table, layout, ranges, coord, theme, params) {
+ table <- FacetRagged$attach_axes(table, layout, ranges, coord, theme, params)
- # Render row strips that FacetWrap didn't know about
- strip_data <- vctrs::vec_unique(layout[names(params$rows)])
- strips <- render_strips(NULL, strip_data, params$labeller, theme)
+ if (!params$axes$x && !params$free$x)
+ table <- cull_inner_panel_decorations(table, layout, sides = c("t", "b"), kind = "axis")
- panel_pos_rows <- panel_rows(panel_table)
- panel_pos_cols <- panel_cols(panel_table)
+ if (!params$axes$y)
+ table <- cull_inner_panel_decorations(table, layout, sides = c("l", "r"), kind = "axis")
- strip_layout_row <- seq_len(max(layout$ROW))
- strip_pos_t <- panel_pos_rows$t[strip_layout_row]
-
- if (params$switch$y) {
- # Add strips to the left of the panels in the first column
- strip_name <- sprintf("strip-l-%d", strip_layout_row)
- strip_layout_col <- rep(1L, length(strip_layout_row))
- strip_pos_l <- panel_pos_cols$l[strip_layout_col]
- strip_width <- max_width(strips$y$left)
-
- panel_table <- gtable_add_cols(panel_table, strip_width, min(strip_pos_l) - 1L)
- panel_table <- gtable_add_grob(panel_table, strips$y$left, strip_pos_t, strip_pos_l, clip = "on", name = strip_name, z = 2)
- } else {
- # Add strips to the right of the panels in the last column on each row
- strip_name <- sprintf("strip-r-%d", strip_layout_row)
- strip_layout_col <- tapply(layout$COL, layout$ROW, max)
- strip_pos_l <- panel_pos_cols$r[strip_layout_col] + 1L
- strip_width <- max_width(strips$y$right)
-
- # Pad strips to start at the edge of the panel
- in_last_col <- strip_layout_col == max(strip_layout_col)
- strips$y$right <- iapply(strips$y$right, !in_last_col, function(strip) {
- if (!is.gtable(strip)) strip else gtable_add_cols(strip, strip_width, 0L)
- })
+ table
+ },
- # Shift axes to start at the edge of the strip
- row <- strip_layout_row[!in_last_col]
- col <- strip_layout_col[!in_last_col]
- axis_name <- sprintf("axis-r-%d-%d", row, col)
- axes <- gtable_get_grob(panel_table, axis_name)
- axes <- lapply(axes, grob_shift_viewport, x = strip_width)
- panel_table <- gtable_set_grob(panel_table, axis_name, axes)
+ attach_strips = function(table, layout, theme, params) {
+ table <- FacetRagged$attach_strips(table, layout, theme, params)
- panel_table <- gtable_add_cols(panel_table, strip_width, max(strip_pos_l) - 1L)
- panel_table <- gtable_add_grob(panel_table, strips$y$right, strip_pos_t, strip_pos_l, clip = "off", name = strip_name, z = 2)
- }
+ if (params$strips == "margins")
+ table <- cull_inner_panel_decorations(table, layout, sides = c("l", "r"), kind = "strip")
- panel_table
+ table
}
)
diff --git a/R/gtable.R b/R/gtable.R
index 5ba4811..b97921a 100644
--- a/R/gtable.R
+++ b/R/gtable.R
@@ -1,8 +1,20 @@
gtable_get_grob <- function(x, name) {
- x$grobs[match(name, x$layout$name)]
+ x$grobs[[match(name, x$layout$name)]]
}
-gtable_set_grob <- function(x, name, grob) {
+gtable_set_grobs <- function(x, name, grob) {
x$grobs[match(name, x$layout$name)] <- grob
x
}
+
+gtable_set_height <- function(x, name, height) {
+ t <- x$layout$t[match(name, x$layout$name)]
+ x$heights[t] <- height
+ x
+}
+
+gtable_set_width <- function(x, name, width) {
+ l <- x$layout$l[match(name, x$layout$name)]
+ x$widths[l] <- width
+ x
+}
diff --git a/R/utils.R b/R/utils.R
deleted file mode 100644
index a4896d3..0000000
--- a/R/utils.R
+++ /dev/null
@@ -1,3 +0,0 @@
-iapply <- function(X, IND, FUN, ...) {
- replace(X, IND, lapply(X[IND], FUN, ...))
-}
diff --git a/man/facet_ragged.Rd b/man/facet_ragged.Rd
index 9244752..e5ab273 100644
--- a/man/facet_ragged.Rd
+++ b/man/facet_ragged.Rd
@@ -12,7 +12,9 @@ facet_ragged_rows(
cols,
...,
scales = "fixed",
- switch = NULL,
+ switch = "none",
+ strips = "margins",
+ axes = "margins",
labeller = "label_value"
)
@@ -21,23 +23,35 @@ facet_ragged_cols(
cols,
...,
scales = "fixed",
- switch = NULL,
+ switch = "none",
+ strips = "margins",
+ axes = "margins",
labeller = "label_value"
)
}
\arguments{
\item{rows, cols}{A set of variables or expressions quoted by \code{\link[ggplot2:vars]{ggplot2::vars()}},
-the combinations of which define panels to be included in the grid.}
+the combinations of which define the panels to be included in the layout.}
\item{...}{Arguments reserved for future use.}
-\item{scales}{Should all panels share the same scales (\code{"fixed"}),
-x-axes vary (\code{"free_x"}), y-axes vary (\code{"free_y"}), or both (\code{"free"})?
-Panels within groups always share the scale along the grouping dimension.}
+\item{scales}{Should all panels share the same scales (\code{"fixed"}), x-axes
+vary (\code{"free_x"}), y-axes vary (\code{"free_y"}), or both (\code{"free"})? Panels
+within groups always share the scale along the grouping dimension.}
-\item{switch}{By default, facet labels are positioned to the top and right
-of the panels. Use \code{"x"} to switch the top strip to the bottom,
-use \code{"y"} to switch the right strip to the left, or \code{"both"}.}
+\item{switch}{Determines how facet label strips are positioned. By default
+(\code{"none"}), strips are drawn to the top and right of the panels. Use \code{"x"}
+to switch the top strip to the bottom, use \code{"y"} to switch the right strip
+to the left, or \code{"both"} to do both.}
+
+\item{strips}{Determines which facet label strips are drawn. By default
+(\code{"margins"}), strips between panels along the grouping dimension will be
+suppressed. Use \code{"all"} to always draw both strips.}
+
+\item{axes}{Determines which axes are drawn. By default (\code{"margins"}), axes
+between panels will be suppressed if they are fixed. Use \code{"all_x"} to
+always draw x-axes, \code{"all_y"} to always draw y-axes, or \code{"all"} to always
+draw both axes.}
\item{labeller}{A function that takes one data frame of labels and
returns a list or data frame of character vectors. Each input
diff --git a/tests/testthat/_snaps/facet_ragged_cols/x-axes-have-varying-ranges-when-free.svg b/tests/testthat/_snaps/facet_ragged_cols/x-axes-have-varying-ranges-when-free.svg
new file mode 100644
index 0000000..a65024c
--- /dev/null
+++ b/tests/testthat/_snaps/facet_ragged_cols/x-axes-have-varying-ranges-when-free.svg
@@ -0,0 +1,386 @@
+
+
diff --git a/tests/testthat/_snaps/facet_ragged_cols/x-axes-on-both-sides-default.svg b/tests/testthat/_snaps/facet_ragged_cols/x-axes-on-both-sides-default.svg
index 1359784..7e7b7f7 100644
--- a/tests/testthat/_snaps/facet_ragged_cols/x-axes-on-both-sides-default.svg
+++ b/tests/testthat/_snaps/facet_ragged_cols/x-axes-on-both-sides-default.svg
@@ -31,15 +31,6 @@
-
-
-
-
-
-
-
-
-
@@ -63,128 +54,377 @@
-
-
+
+
-
-
-2
+
+
+
+
+
+
+
+
+
+
+
+
+1.0
+1.5
+2.0
+2.5
+3.0
+
+
+
+
+
+
-
-
+
+
-
-
-3
+
+
+
+
+
+
+
+
+
+
+
+
+1.0
+1.5
+2.0
+2.5
+3.0
+
+
+
+
+
+
-
-
+
+
-
-
-1
+
-
-
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+1.0
+1.5
+2.0
+2.5
+3.0
+
+
+
+
+
+
-
-
+
+
-
-
-A
+
-
-
+
+
-
-
-B
+
-1.0
-1.5
-2.0
-2.5
-3.0
-
-
-
-
-
-1.0
-1.5
-2.0
-2.5
-3.0
-
-
-
-
-
+
+
+
+
1.0
1.5
2.0
2.5
3.0
-
-
-
-
-
-1.0
-1.5
-2.0
-2.5
-3.0
-1.0
-1.5
-2.0
-2.5
-3.0
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
1.0
1.5
2.0
2.5
3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+1.0
+1.5
+2.0
+2.5
+3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+A
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+B
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+1
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+2
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+3
+
+
+
+
x
x
y
diff --git a/tests/testthat/_snaps/facet_ragged_cols/x-axes-on-both-sides-switched.svg b/tests/testthat/_snaps/facet_ragged_cols/x-axes-on-both-sides-switched.svg
index f9f39aa..8d254bf 100644
--- a/tests/testthat/_snaps/facet_ragged_cols/x-axes-on-both-sides-switched.svg
+++ b/tests/testthat/_snaps/facet_ragged_cols/x-axes-on-both-sides-switched.svg
@@ -31,15 +31,6 @@
-
-
-
-
-
-
-
-
-
@@ -63,110 +54,381 @@
-
-
+
+
-
-
-2
+
+
+
+
+
+
+
+
+
+
+
+
+1.0
+1.5
+2.0
+2.5
+3.0
+
+
+
+
+
+
-
-
+
+
-
-
-3
+
+
+
+
+
+
+
+
+
+
+
+
+1.0
+1.5
+2.0
+2.5
+3.0
+
+
+
+
+
+
-
-
+
+
-
-
-1
+
-
-
+
+
-
+
+
+
+
+
-
-A
-
-B
-1.0
-1.5
-2.0
-2.5
-3.0
-
-
-
-
-
-1.0
-1.5
-2.0
-2.5
-3.0
-
-
-
-
-
-
-
-
-
-
-1.0
-1.5
-2.0
-2.5
-3.0
+
+
+
+
1.0
1.5
2.0
2.5
3.0
-1.0
-1.5
-2.0
-2.5
-3.0
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+1.0
+1.5
+2.0
+2.5
+3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
1.0
1.5
2.0
2.5
3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+1.0
+1.5
+2.0
+2.5
+3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+A
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+B
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+1
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+2
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+3
+
+
+
+
x
x
y
diff --git a/tests/testthat/_snaps/facet_ragged_rows/y-axes-on-both-sides-default.svg b/tests/testthat/_snaps/facet_ragged_rows/y-axes-on-both-sides-default.svg
index bf3d016..027015d 100644
--- a/tests/testthat/_snaps/facet_ragged_rows/y-axes-on-both-sides-default.svg
+++ b/tests/testthat/_snaps/facet_ragged_rows/y-axes-on-both-sides-default.svg
@@ -43,133 +43,400 @@
-
-
+
+
-
+
+
+
-
-
+
+
-
-
-
+
-
-
+
+
-
-
-2
+
-
-
+
+
-
-
-3
+
-
-
+
+
-
-
-1
+
-
-
+
+
-
+
-
-A
-
-B
+
+
+
+
1.0
1.5
2.0
2.5
3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
1.0
1.5
2.0
2.5
3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
1.0
1.5
2.0
2.5
3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
1.0
1.5
2.0
2.5
3.0
+
+
+
+
-
-
-
-
-
-1.0
-1.5
-2.0
-2.5
-3.0
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
1.0
1.5
2.0
2.5
3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+1.0
+1.5
+2.0
+2.5
+3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+1
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+2
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+3
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+A
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+B
+
+
+
+
x
y
-y
+y
y axes on both sides, default
diff --git a/tests/testthat/_snaps/facet_ragged_rows/y-axes-on-both-sides-switched.svg b/tests/testthat/_snaps/facet_ragged_rows/y-axes-on-both-sides-switched.svg
index d0988fb..73a9bc8 100644
--- a/tests/testthat/_snaps/facet_ragged_rows/y-axes-on-both-sides-switched.svg
+++ b/tests/testthat/_snaps/facet_ragged_rows/y-axes-on-both-sides-switched.svg
@@ -42,15 +42,6 @@
-
-
-
-
-
-
-
-
-
@@ -63,66 +54,47 @@
-
-
+
+
-
-
-2
+
-
-
+
+
-
-
-3
+
-
-
-
-
-
-
-1
-
-
-
-
-
-
+
+
-
+
-
-
+
+
-
-
-A
+
-
-
+
+
-
-
-B
+
@@ -130,64 +102,337 @@
+
+
+
+
1.0
1.5
2.0
2.5
3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
1.0
1.5
2.0
2.5
3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
1.0
1.5
2.0
2.5
3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
1.0
1.5
2.0
2.5
3.0
+
+
+
+
-
-
-
-
-
-1.0
-1.5
-2.0
-2.5
-3.0
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
1.0
1.5
2.0
2.5
3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+1.0
+1.5
+2.0
+2.5
+3.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+1
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+2
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+3
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+A
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+B
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
x
y
-y
+y
y axes on both sides, switched
diff --git a/tests/testthat/test-facet_ragged_cols.R b/tests/testthat/test-facet_ragged_cols.R
index 087a2d7..4eced64 100644
--- a/tests/testthat/test-facet_ragged_cols.R
+++ b/tests/testthat/test-facet_ragged_cols.R
@@ -9,3 +9,9 @@ test_that("axes and strips don't overlap", {
p <- p + facet_ragged_cols(vars(bar), vars(foo), switch = "x")
vdiffr::expect_doppelganger("x axes on both sides, switched", p)
})
+
+test_that("correct axes are rendered with free and coord_flip (#2)", {
+ p <- ggplot(tbl, aes(x, y)) + coord_flip()
+ p <- p + facet_ragged_cols(vars(bar), vars(foo), scales = "free_x")
+ vdiffr::expect_doppelganger("x axes have varying ranges when free", p)
+})