From d08b61ade9c0352e3ad7f62c9ffbcb653a758365 Mon Sep 17 00:00:00 2001 From: stefanedwards Date: Thu, 27 Apr 2017 16:23:37 +0100 Subject: [PATCH 1/7] Adding saved state of facet-rep-lab.r --- R/facet-rep-lab.r | 131 ++++++++++++++++++++++++++-------------------- 1 file changed, 75 insertions(+), 56 deletions(-) diff --git a/R/facet-rep-lab.r b/R/facet-rep-lab.r index f293cbe..ac8665e 100644 --- a/R/facet-rep-lab.r +++ b/R/facet-rep-lab.r @@ -214,28 +214,47 @@ facet_rep_wrap <- function(facets, shrink=TRUE, repeat.tick.labels=FALSE, .debug FacetWrapRepeatLabels <- ggplot2::ggproto('FacetWrapRepeatLabels', `_inherit`=ggplot2::FacetWrap, draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { table <- FacetWrap$draw_panels(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) - if (params$.debug) { saveRDS(table, file='table.rds')} + if (params$.debug) { saveRDS(list(table=table, panels=panels, params=params), file='table.rds')} # Add axes across all panels panels <- table$layout[grepl("^panel", table$layout$name), , drop = FALSE] - #cord <- do.call(rbind, strsplit(panels$name, split='-', fixed = TRUE)) panels$col <- as.integer(as.factor(panels$l))# as.integer(cord[,3]) panels$row <- as.integer(as.factor(panels$t))#as.integer(cord[,2]) # axes are placed on all four sides of **all** panels, but are in most cases zeroGrobs. - # axis_b <- table$grobs[grepl('axis-b-[[:digit:]]+', table$layout$name)] - axis_l <- table$grobs[grepl('axis-l-[[:digit:]]+', table$layout$name)] - axis_t <- table$grobs[grepl('axis-t-[[:digit:]]+', table$layout$name)] - axis_r <- table$grobs[grepl('axis-r-[[:digit:]]+', table$layout$name)] + #axis_l <- table$grobs[grepl('axis-l-[[:digit:]]+', table$layout$name)] + #axis_t <- table$grobs[grepl('axis-t-[[:digit:]]+', table$layout$name)] + #axis_r <- table$grobs[grepl('axis-r-[[:digit:]]+', table$layout$name)] + # + #if (params$repeat.tick.labels == FALSE) { + # axis_b <- lapply(axis_b, remove_labels_from_axis) + # axis_l <- lapply(axis_l, remove_labels_from_axis) + # axis_t <- lapply(axis_t, remove_labels_from_axis) + # axis_r <- lapply(axis_r, remove_labels_from_axis) + #} - if (params$repeat.tick.labels == FALSE) { - axis_b <- lapply(axis_b, remove_labels_from_axis) - axis_l <- lapply(axis_l, remove_labels_from_axis) - axis_t <- lapply(axis_t, remove_labels_from_axis) - axis_r <- lapply(axis_r, remove_labels_from_axis) + prev.is.copy <- FALSE + update.widths <- integer(max(panels$col)) + for (i in 2:max(panels$col)) { + for (j in 1:max(panels$row)) { + #pk <- which(panels$col == i - 1 & panels$row == j) + pl <- which(panels$col == i & panels$row == j) + if (length(pl) == 0) next + if (inherits(table$grobs[[which(table$layout$name == panels$name[pl])]], 'zeroGrob')) next + #if (length(pk) == 0 | length(pl) == 0) next + + prev.grob <- table$grobs[[which(table$layout$name == sprintf('axis-l-%i-%i', j, i-1))]] + if (!prev.is.copy & params$repeat.tick.labels) { + prev.grob <- remove_labels_from_axis(prev.grob) + prev.is.copy <- TRUE + } + table$grobs[[which(table$layout$name == sprintf('axis-l-%i-%i', j, i))]] <- prev.grob + } } + # update widths + # panel_range <- ggplot2:::find_panel(table) # panel_range[,c('col','row')] <- c(max(panels$col), max(panels$row)) @@ -247,51 +266,51 @@ FacetWrapRepeatLabels <- ggplot2::ggproto('FacetWrapRepeatLabels', `_inherit`=gg - for (i in nrow(panels):1) { - p <- panels[i,] - # Bottom - if (p$row != panel_range$row & !inherits(axis_b[[p$col]], 'zeroGrob')) { # panel not in bottom row, (add row), add axis - coord <- table$layout[table$layout$name == p$name, ] - if (b_axis_row_added[p$row] == FALSE) { - b_axis_row_added[p$row] <- TRUE - table <- gtable_add_rows(table, max_height(axis_b), coord$b) - } - table <- gtable_add_grob(table, axis_b[[p$col]], t=coord$b+1, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-b-%d-%d', p$col, p$row)) - } - # Left - if (p$col > 1 & !inherits(axis_l[[p$row]], 'zeroGrob')) { # panel is not left-most column, (add column), add axis - coord <- table$layout[table$layout$name == p$name, ] - if (l_axis_column_added[p$col] == FALSE) { - l_axis_column_added[p$col] <- TRUE - table <- gtable_add_cols(table, max_width(axis_l), coord$l-1) - table <- gtable_add_grob(table, axis_l[[p$row]], t=coord$t, b=coord$b, l=coord$l, clip='off', name=sprintf('axis-l-%d-%d', p$row, p$col)) - } else { - table <- gtable_add_grob(table, axis_l[[p$row]], t=coord$t, b=coord$b, l=coord$l-1, clip='off', name=sprintf('axis-l-%d-%d', p$row, p$col)) - } - } - # Top - if (p$row > 1 & !inherits(axis_t[[p$col]], 'zeroGrob')) { # panel not in top row, (add row), add axis - coord <- table$layout[table$layout$name == p$name, ] - if (t_axis_row_added[p$row] == FALSE) { - t_axis_row_added[p$row] <- TRUE - table <- gtable_add_rows(table, max_height(axis_t), coord$t-1) - table <- gtable_add_grob(table, axis_t[[p$col]], t=coord$t, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-t-%d-%d', p$col, p$row)) - } else { - table <- gtable_add_grob(table, axis_t[[p$col]], t=coord$t-1, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-t-%d-%d', p$col, p$row)) - } - - } - # Right - if (p$col != panel_range$col & !inherits(axis_l[[p$row]], 'zeroGrob')) { # panel is not right-most, (add colun), add axis - coord <- table$layout[table$layout$name == p$name, ] - if (r_axis_column_added[p$col] == FALSE) { - r_axis_column_added[p$col] <- TRUE - table <- gtable_add_cols(table, max_width(axis_r), coord$r) - } - table <- gtable_add_grob(table, axis_r[[p$row]], t=coord$t, b=coord$b, l=coord$r+1, clip='off', name=sprintf('axis-r-%d-%d', p$row, p$col)) - } - - } + # for (i in nrow(panels):1) { + # p <- panels[i,] + # # Bottom + # if (p$row != panel_range$row & !inherits(axis_b[[p$col]], 'zeroGrob')) { # panel not in bottom row, (add row), add axis + # coord <- table$layout[table$layout$name == p$name, ] + # if (b_axis_row_added[p$row] == FALSE) { + # b_axis_row_added[p$row] <- TRUE + # table <- gtable_add_rows(table, max_height(axis_b), coord$b) + # } + # table <- gtable_add_grob(table, axis_b[[p$col]], t=coord$b+1, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-b-%d-%d', p$col, p$row)) + # } + # # Left + # if (p$col > 1 & !inherits(axis_l[[p$row]], 'zeroGrob')) { # panel is not left-most column, (add column), add axis + # coord <- table$layout[table$layout$name == p$name, ] + # if (l_axis_column_added[p$col] == FALSE) { + # l_axis_column_added[p$col] <- TRUE + # table <- gtable_add_cols(table, max_width(axis_l), coord$l-1) + # table <- gtable_add_grob(table, axis_l[[p$row]], t=coord$t, b=coord$b, l=coord$l, clip='off', name=sprintf('axis-l-%d-%d', p$row, p$col)) + # } else { + # table <- gtable_add_grob(table, axis_l[[p$row]], t=coord$t, b=coord$b, l=coord$l-1, clip='off', name=sprintf('axis-l-%d-%d', p$row, p$col)) + # } + # } + # # Top + # if (p$row > 1 & !inherits(axis_t[[p$col]], 'zeroGrob')) { # panel not in top row, (add row), add axis + # coord <- table$layout[table$layout$name == p$name, ] + # if (t_axis_row_added[p$row] == FALSE) { + # t_axis_row_added[p$row] <- TRUE + # table <- gtable_add_rows(table, max_height(axis_t), coord$t-1) + # table <- gtable_add_grob(table, axis_t[[p$col]], t=coord$t, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-t-%d-%d', p$col, p$row)) + # } else { + # table <- gtable_add_grob(table, axis_t[[p$col]], t=coord$t-1, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-t-%d-%d', p$col, p$row)) + # } + # + # } + # # Right + # if (p$col != panel_range$col & !inherits(axis_l[[p$row]], 'zeroGrob')) { # panel is not right-most, (add colun), add axis + # coord <- table$layout[table$layout$name == p$name, ] + # if (r_axis_column_added[p$col] == FALSE) { + # r_axis_column_added[p$col] <- TRUE + # table <- gtable_add_cols(table, max_width(axis_r), coord$r) + # } + # table <- gtable_add_grob(table, axis_r[[p$row]], t=coord$t, b=coord$b, l=coord$r+1, clip='off', name=sprintf('axis-r-%d-%d', p$row, p$col)) + # } + # + # } table } From 625dcc3b1cff45ce02baf617eb8e536e40ca58f1 Mon Sep 17 00:00:00 2001 From: stefanedwards Date: Thu, 27 Apr 2017 22:32:35 +0100 Subject: [PATCH 2/7] facet_rep_wrap now works! --- R/facet-rep-lab.r | 176 +++---------------------- R/facet-wrap.r | 205 ++++++++++++++++++++++++++++++ man/facet_rep_wrap.Rd | 8 +- man/g_legend.Rd | 7 +- man/ggplot2-ggproto.Rd | 8 +- man/grid_arrange_shared_legend.Rd | 1 - man/if-not-null.Rd | 3 +- man/knit_print.Rd | 3 +- man/remove_labels_from_axis.Rd | 1 - man/reposition_legend.Rd | 7 +- man/splot.Rd | 3 +- man/waiver.Rd | 5 +- vignettes/capped-axes.Rmd | 10 +- 13 files changed, 253 insertions(+), 184 deletions(-) create mode 100644 R/facet-wrap.r diff --git a/R/facet-rep-lab.r b/R/facet-rep-lab.r index ac8665e..7a80554 100644 --- a/R/facet-rep-lab.r +++ b/R/facet-rep-lab.r @@ -5,9 +5,9 @@ NULL NULL #' Lay out panels in a grid with axes replicated across all panels. -#' +#' #' \strong{Documentation is straight from \code{\link[ggplot2]{facet_grid}}.} -#' Only addition is this function \emph{copies the axis across all panels}. +#' Only addition is this function \emph{copies the axis across all panels}. #' \code{repeat.tick.labels=FALSE} removes the labels (numbering) on an axis. #' #' \code{facet_grid} forms a matrix of panels defined by row and column @@ -63,15 +63,15 @@ NULL facet_rep_grid <- function(facets, shrink=TRUE, repeat.tick.labels=FALSE, .debug=FALSE, ...) { f <- facet_grid(facets, shrink=shrink, ...) params <- append(f$params, list(repeat.tick.labels=repeat.tick.labels, .debug=.debug)) - ggproto(NULL, FacetGridRepeatLabels, + ggproto(NULL, FacetGridRepeatLabels, shrink=shrink, params=params) } #' Removes labels from axis grobs. -#' +#' #' Called from FacetGridRepeatLabels. -#' +#' #' @param axisgrob Grob with an axis. #' @keywords interal remove_labels_from_axis <- function(axisgrob) { @@ -97,33 +97,32 @@ FacetGridRepeatLabels <- ggplot2::ggproto('FacetGridRepeatLabels', `_inherit`=gg draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { table <- FacetGrid$draw_panels(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) if (params$.debug) { saveRDS(table, file='table.rds')} - + # Add axes across all panels panels <- table$layout[grepl("^panel", table$layout$name), , drop = FALSE] - #cord <- do.call(rbind, strsplit(panels$name, split='-', fixed = TRUE)) - panels$col <- as.integer(as.factor(panels$l))# as.integer(cord[,3]) - panels$row <- as.integer(as.factor(panels$t))#as.integer(cord[,2]) - + panels$col <- as.integer(as.factor(panels$l)) + panels$row <- as.integer(as.factor(panels$t)) + axis_b <- table$grobs[grepl('axis-b-[[:digit:]]+', table$layout$name)] axis_l <- table$grobs[grepl('axis-l-[[:digit:]]+', table$layout$name)] axis_t <- table$grobs[grepl('axis-t-[[:digit:]]+', table$layout$name)] axis_r <- table$grobs[grepl('axis-r-[[:digit:]]+', table$layout$name)] - + if (params$repeat.tick.labels == FALSE) { axis_b <- lapply(axis_b, remove_labels_from_axis) axis_l <- lapply(axis_l, remove_labels_from_axis) axis_t <- lapply(axis_t, remove_labels_from_axis) axis_r <- lapply(axis_r, remove_labels_from_axis) } - + panel_range <- find_panel(table) panel_range[,c('col','row')] <- c(max(panels$col), max(panels$row)) - + l_axis_column_added <- logical(panel_range$col) r_axis_column_added <- logical(panel_range$col) t_axis_row_added <- logical(panel_range$row) b_axis_row_added <- logical(panel_range$row) - + for (i in nrow(panels):1) { p <- panels[i,] # Bottom @@ -154,9 +153,9 @@ FacetGridRepeatLabels <- ggplot2::ggproto('FacetGridRepeatLabels', `_inherit`=gg table <- gtable_add_rows(table, max_height(axis_t), coord$t-1) table <- gtable_add_grob(table, axis_t[[p$col]], t=coord$t, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-t-%d-%d', p$col, p$row)) } else { - table <- gtable_add_grob(table, axis_t[[p$col]], t=coord$t-1, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-t-%d-%d', p$col, p$row)) + table <- gtable_add_grob(table, axis_t[[p$col]], t=coord$t-1, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-t-%d-%d', p$col, p$row)) } - + } # Right if (p$col != panel_range$col & !inherits(axis_l[[p$row]], 'zeroGrob')) { # panel is not right-most, (add colun), add axis @@ -167,151 +166,10 @@ FacetGridRepeatLabels <- ggplot2::ggproto('FacetGridRepeatLabels', `_inherit`=gg } table <- gtable_add_grob(table, axis_r[[p$row]], t=coord$t, b=coord$b, l=coord$r+1, clip='off', name=sprintf('axis-r-%d-%d', p$row, p$col)) } - + } - + table } ) -# facet_wrap --------------- -NULL - -#' Wrap a 1d ribbon of panels into 2d -#' -#' \code{facet_wrap} wraps a 1d sequence of panels into 2d. This is generally -#' a better use of screen space than \code{\link{facet_grid}} because most -#' displays are roughly rectangular. -#' -#' @param facets Either a formula or character vector. Use either a -#' one sided formula, \code{~a + b}, or a character vector, \code{c("a", "b")}. -#' @param nrow,ncol Number of rows and columns. -#' @param scales should Scales be fixed (\code{"fixed"}, the default), -#' free (\code{"free"}), or free in one dimension (\code{"free_x"}, -#' \code{"free_y"}). -#' @param strip.position By default, the labels are displayed on the top of -#' the plot. Using \code{strip.position} it is possible to place the labels on -#' either of the four sides by setting \code{strip.position = c("top", -#' "bottom", "left", "right")} -#' @param dir Direction: either "h" for horizontal, the default, or "v", for -#' vertical. -#' @inheritParams facet_rep_grid -#' @export -facet_rep_wrap <- function(facets, shrink=TRUE, repeat.tick.labels=FALSE, .debug=FALSE, ...) { - f <- facet_wrap(facets, shrink=shrink, ...) - params <- append(f$params, list(repeat.tick.labels=repeat.tick.labels, .debug=.debug)) - ggproto(NULL, FacetWrapRepeatLabels, - shrink=shrink, - params=params) -} - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -#' @importFrom ggplot2 FacetWrap ggproto -#' @importFrom gtable gtable_add_cols gtable_add_grob gtable_add_rows -FacetWrapRepeatLabels <- ggplot2::ggproto('FacetWrapRepeatLabels', `_inherit`=ggplot2::FacetWrap, - draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { - table <- FacetWrap$draw_panels(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) - if (params$.debug) { saveRDS(list(table=table, panels=panels, params=params), file='table.rds')} - - # Add axes across all panels - panels <- table$layout[grepl("^panel", table$layout$name), , drop = FALSE] - panels$col <- as.integer(as.factor(panels$l))# as.integer(cord[,3]) - panels$row <- as.integer(as.factor(panels$t))#as.integer(cord[,2]) - - # axes are placed on all four sides of **all** panels, but are in most cases zeroGrobs. - - axis_b <- table$grobs[grepl('axis-b-[[:digit:]]+', table$layout$name)] - #axis_l <- table$grobs[grepl('axis-l-[[:digit:]]+', table$layout$name)] - #axis_t <- table$grobs[grepl('axis-t-[[:digit:]]+', table$layout$name)] - #axis_r <- table$grobs[grepl('axis-r-[[:digit:]]+', table$layout$name)] - # - #if (params$repeat.tick.labels == FALSE) { - # axis_b <- lapply(axis_b, remove_labels_from_axis) - # axis_l <- lapply(axis_l, remove_labels_from_axis) - # axis_t <- lapply(axis_t, remove_labels_from_axis) - # axis_r <- lapply(axis_r, remove_labels_from_axis) - #} - - prev.is.copy <- FALSE - update.widths <- integer(max(panels$col)) - for (i in 2:max(panels$col)) { - for (j in 1:max(panels$row)) { - #pk <- which(panels$col == i - 1 & panels$row == j) - pl <- which(panels$col == i & panels$row == j) - if (length(pl) == 0) next - if (inherits(table$grobs[[which(table$layout$name == panels$name[pl])]], 'zeroGrob')) next - #if (length(pk) == 0 | length(pl) == 0) next - - prev.grob <- table$grobs[[which(table$layout$name == sprintf('axis-l-%i-%i', j, i-1))]] - if (!prev.is.copy & params$repeat.tick.labels) { - prev.grob <- remove_labels_from_axis(prev.grob) - prev.is.copy <- TRUE - } - table$grobs[[which(table$layout$name == sprintf('axis-l-%i-%i', j, i))]] <- prev.grob - } - } - # update widths - - - # panel_range <- ggplot2:::find_panel(table) - # panel_range[,c('col','row')] <- c(max(panels$col), max(panels$row)) - # - # l_axis_column_added <- logical(panel_range$col) - # r_axis_column_added <- logical(panel_range$col) - # t_axis_row_added <- logical(panel_range$row) - # b_axis_row_added <- logical(panel_range$row) - - - - # for (i in nrow(panels):1) { - # p <- panels[i,] - # # Bottom - # if (p$row != panel_range$row & !inherits(axis_b[[p$col]], 'zeroGrob')) { # panel not in bottom row, (add row), add axis - # coord <- table$layout[table$layout$name == p$name, ] - # if (b_axis_row_added[p$row] == FALSE) { - # b_axis_row_added[p$row] <- TRUE - # table <- gtable_add_rows(table, max_height(axis_b), coord$b) - # } - # table <- gtable_add_grob(table, axis_b[[p$col]], t=coord$b+1, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-b-%d-%d', p$col, p$row)) - # } - # # Left - # if (p$col > 1 & !inherits(axis_l[[p$row]], 'zeroGrob')) { # panel is not left-most column, (add column), add axis - # coord <- table$layout[table$layout$name == p$name, ] - # if (l_axis_column_added[p$col] == FALSE) { - # l_axis_column_added[p$col] <- TRUE - # table <- gtable_add_cols(table, max_width(axis_l), coord$l-1) - # table <- gtable_add_grob(table, axis_l[[p$row]], t=coord$t, b=coord$b, l=coord$l, clip='off', name=sprintf('axis-l-%d-%d', p$row, p$col)) - # } else { - # table <- gtable_add_grob(table, axis_l[[p$row]], t=coord$t, b=coord$b, l=coord$l-1, clip='off', name=sprintf('axis-l-%d-%d', p$row, p$col)) - # } - # } - # # Top - # if (p$row > 1 & !inherits(axis_t[[p$col]], 'zeroGrob')) { # panel not in top row, (add row), add axis - # coord <- table$layout[table$layout$name == p$name, ] - # if (t_axis_row_added[p$row] == FALSE) { - # t_axis_row_added[p$row] <- TRUE - # table <- gtable_add_rows(table, max_height(axis_t), coord$t-1) - # table <- gtable_add_grob(table, axis_t[[p$col]], t=coord$t, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-t-%d-%d', p$col, p$row)) - # } else { - # table <- gtable_add_grob(table, axis_t[[p$col]], t=coord$t-1, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-t-%d-%d', p$col, p$row)) - # } - # - # } - # # Right - # if (p$col != panel_range$col & !inherits(axis_l[[p$row]], 'zeroGrob')) { # panel is not right-most, (add colun), add axis - # coord <- table$layout[table$layout$name == p$name, ] - # if (r_axis_column_added[p$col] == FALSE) { - # r_axis_column_added[p$col] <- TRUE - # table <- gtable_add_cols(table, max_width(axis_r), coord$r) - # } - # table <- gtable_add_grob(table, axis_r[[p$row]], t=coord$t, b=coord$b, l=coord$r+1, clip='off', name=sprintf('axis-r-%d-%d', p$row, p$col)) - # } - # - # } - - table - } -) \ No newline at end of file diff --git a/R/facet-wrap.r b/R/facet-wrap.r new file mode 100644 index 0000000..e3b40a9 --- /dev/null +++ b/R/facet-wrap.r @@ -0,0 +1,205 @@ +#' @include ggplot2.r +NULL + +#' Wrap a 1d ribbon of panels into 2d +#' +#' \code{facet_wrap} wraps a 1d sequence of panels into 2d. This is generally +#' a better use of screen space than \code{\link{facet_grid}} because most +#' displays are roughly rectangular. +#' +#' @param facets Either a formula or character vector. Use either a +#' one sided formula, \code{~a + b}, or a character vector, \code{c("a", "b")}. +#' @param nrow,ncol Number of rows and columns. +#' @param scales should Scales be fixed (\code{"fixed"}, the default), +#' free (\code{"free"}), or free in one dimension (\code{"free_x"}, +#' \code{"free_y"}). +#' @param strip.position By default, the labels are displayed on the top of +#' the plot. Using \code{strip.position} it is possible to place the labels on +#' either of the four sides by setting \code{strip.position = c("top", +#' "bottom", "left", "right")} +#' @param dir Direction: either "h" for horizontal, the default, or "v", for +#' vertical. +#' @inheritParams facet_rep_grid +#' @importFrom ggplot2 facet_wrap +#' @export +#' @examples +#' ggplot(mpg, aes(displ, hwy)) + +#' geom_point() + +#' facet_wrap(~class) +facet_rep_wrap <- function(facets, shrink=TRUE, repeat.tick.labels=FALSE, .debug=FALSE, ...) { + f <- facet_wrap(facets, shrink=shrink, ...) + params <- append(f$params, list(repeat.tick.labels=repeat.tick.labels, .debug=.debug)) + ggproto(NULL, FacetWrapRepeatLabels, + shrink=shrink, + params=params) +} + + +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +#' @importFrom ggplot2 FacetWrap ggproto +#' @importFrom gtable gtable_add_cols gtable_add_grob gtable_add_rows +FacetWrapRepeatLabels <- ggplot2::ggproto('FacetWrapRepeatLabels', + `_inherit`=ggplot2::FacetWrap, + draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { + # If coord is non-cartesian and (x is free or y is free) + # then throw error + if ((!inherits(coord, "CoordCartesian")) && (params$free$x || params$free$y)) { + stop("ggplot2 does not currently support free scales with a non-cartesian coord", call. = FALSE) + } + if (inherits(coord, "CoordFlip")) { + if (params$free$x) { + layout$SCALE_X <- seq_len(nrow(layout)) + } else { + layout$SCALE_X <- 1L + } + if (params$free$y) { + layout$SCALE_Y <- seq_len(nrow(layout)) + } else { + layout$SCALE_Y <- 1L + } + } + + ncol <- max(layout$COL) + nrow <- max(layout$ROW) + n <- nrow(layout) + panel_order <- order(layout$ROW, layout$COL) + layout <- layout[panel_order, ] + panels <- panels[panel_order] + panel_pos <- ggplot2:::convertInd(layout$ROW, layout$COL, nrow) + + axes <- ggplot2:::render_axes(ranges, ranges, coord, theme, transpose = TRUE) + + labels_df <- layout[names(params$facets)] + attr(labels_df, "facet") <- "wrap" + strips <- render_strips( + structure(labels_df, type = "rows"), + structure(labels_df, type = "cols"), + params$labeller, theme) + + # If user hasn't set aspect ratio, and we have fixed scales, then + # ask the coordinate system if it wants to specify one + aspect_ratio <- theme$aspect.ratio + if (is.null(aspect_ratio) && !params$free$x && !params$free$y) { + aspect_ratio <- coord$aspect(ranges[[1]]) + } + + if (is.null(aspect_ratio)) { + aspect_ratio <- 1 + respect <- FALSE + } else { + respect <- TRUE + } + + empty_table <- matrix(list(zeroGrob()), nrow = nrow, ncol = ncol) + panel_table <- empty_table + panel_table[panel_pos] <- panels + empties <- apply(panel_table, c(1,2), function(x) ggplot2:::is.zero(x[[1]])) + panel_table <- gtable_matrix("layout", panel_table, + widths = unit(rep(1, ncol), "null"), + heights = unit(rep(aspect_ratio, nrow), "null"), respect = respect, clip = "on", z = matrix(1, ncol = ncol, nrow = nrow)) + panel_table$layout$name <- paste0('panel-', rep(seq_len(ncol), nrow), '-', rep(seq_len(nrow), each = ncol)) + + panel_table <- gtable_add_col_space(panel_table, + theme$panel.spacing.x %||% theme$panel.spacing) + panel_table <- gtable_add_row_space(panel_table, + theme$panel.spacing.y %||% theme$panel.spacing) + + # Add axes + axis_mat_x_top <- empty_table + axis_mat_x_top[panel_pos] <- axes$x$top[layout$SCALE_X] + axis_mat_x_bottom <- empty_table + axis_mat_x_bottom[panel_pos] <- axes$x$bottom[layout$SCALE_X] + axis_mat_y_left <- empty_table + axis_mat_y_left[panel_pos] <- axes$y$left[layout$SCALE_Y] + axis_mat_y_right <- empty_table + axis_mat_y_right[panel_pos] <- axes$y$right[layout$SCALE_Y] + #if (!params$free$x) { + # axis_mat_x_top[-1,]<- list(zeroGrob()) + # axis_mat_x_bottom[-nrow,]<- list(zeroGrob()) + #} + #if (!params$free$y) { + # axis_mat_y_left[, -1] <- list(zeroGrob()) + # axis_mat_y_right[, -ncol] <- list(zeroGrob()) + #} + if (!params$repeat.tick.labels) { + axis_mat_x_top[-1,] <- lapply(axis_mat_x_top[-1,], remove_labels_from_axis) + axis_mat_x_bottom[-nrow,] <- lapply(axis_mat_x_bottom[-nrow,], remove_labels_from_axis) + axis_mat_y_left[,-1] <- lapply(axis_mat_y_left[,-1], remove_labels_from_axis) + axis_mat_y_right[, -ncol] <- lapply(axis_mat_y_right[, -ncol], remove_labels_from_axis) + } + axis_height_top <- unit(apply(axis_mat_x_top, 1, max_height), "cm") + axis_height_bottom <- unit(apply(axis_mat_x_bottom, 1, max_height), "cm") + axis_width_left <- unit(apply(axis_mat_y_left, 2, max_width), "cm") + axis_width_right <- unit(apply(axis_mat_y_right, 2, max_width), "cm") + # Add back missing axes + if (any(empties)) { + first_row <- which(apply(empties, 1, any))[1] - 1 + first_col <- which(apply(empties, 2, any))[1] - 1 + row_panels <- which(layout$ROW == first_row & layout$COL > first_col) + row_pos <- ggplot2:::convertInd(layout$ROW[row_panels], layout$COL[row_panels], nrow) + row_axes <- axes$x$bottom[layout$SCALE_X[row_panels]] + col_panels <- which(layout$ROW > first_row & layout$COL == first_col) + col_pos <- ggplot2:::convertInd(layout$ROW[col_panels], layout$COL[col_panels], nrow) + col_axes <- axes$y$right[layout$SCALE_Y[col_panels]] + if (params$strip.position == "bottom" && + theme$strip.placement != "inside" && + any(!vapply(row_axes, is.zero, logical(length(row_axes))))) { + warning("Suppressing axis rendering when strip.position = 'bottom' and strip.placement == 'outside'", call. = FALSE) + } else { + axis_mat_x_bottom[row_pos] <- row_axes + } + if (params$strip.position == "right" && + theme$strip.placement != "inside" && + any(!vapply(col_axes, is.zero, logical(length(col_axes))))) { + warning("Suppressing axis rendering when strip.position = 'right' and strip.placement == 'outside'", call. = FALSE) + } else { + axis_mat_y_right[col_pos] <- col_axes + } + } + panel_table <- ggplot2:::weave_tables_row(panel_table, axis_mat_x_top, -1, axis_height_top, "axis-t", 3) + panel_table <- ggplot2:::weave_tables_row(panel_table, axis_mat_x_bottom, 0, axis_height_bottom, "axis-b", 3) + panel_table <- ggplot2:::weave_tables_col(panel_table, axis_mat_y_left, -1, axis_width_left, "axis-l", 3) + panel_table <- ggplot2:::weave_tables_col(panel_table, axis_mat_y_right, 0, axis_width_right, "axis-r", 3) + + strip_padding <- convertUnit(theme$strip.switch.pad.wrap, "cm") + strip_name <- paste0("strip-", substr(params$strip.position, 1, 1)) + strip_mat <- empty_table + strip_mat[panel_pos] <- unlist(unname(strips), recursive = FALSE)[[params$strip.position]] + if (params$strip.position %in% c("top", "bottom")) { + inside <- (theme$strip.placement.x %||% theme$strip.placement %||% "inside") == "inside" + if (params$strip.position == "top") { + placement <- if (inside) -1 else -2 + strip_pad <- axis_height_top + } else { + placement <- if (inside) 0 else 1 + strip_pad <- axis_height_bottom + } + strip_height <- unit(apply(strip_mat, 1, max_height), "cm") + panel_table <- ggplot2:::weave_tables_row(panel_table, strip_mat, placement, strip_height, strip_name, 2, "on") + if (!inside) { + strip_pad[unclass(strip_pad) != 0] <- strip_padding + panel_table <- ggplot2:::weave_tables_row(panel_table, row_shift = placement, row_height = strip_pad) + } + } else { + inside <- (theme$strip.placement.y %||% theme$strip.placement %||% "inside") == "inside" + if (params$strip.position == "left") { + placement <- if (inside) -1 else -2 + strip_pad <- axis_width_left + } else { + placement <- if (inside) 0 else 1 + strip_pad <- axis_width_right + } + strip_pad[unclass(strip_pad) != 0] <- strip_padding + strip_width <- unit(apply(strip_mat, 2, max_width), "cm") + panel_table <- ggplot2:::weave_tables_col(panel_table, strip_mat, placement, strip_width, strip_name, 2, "on") + if (!inside) { + strip_pad[unclass(strip_pad) != 0] <- strip_padding + panel_table <- ggplot2:::weave_tables_col(panel_table, col_shift = placement, col_width = strip_pad) + } + } + panel_table + } +) diff --git a/man/facet_rep_wrap.Rd b/man/facet_rep_wrap.Rd index a5479f1..a9f461f 100644 --- a/man/facet_rep_wrap.Rd +++ b/man/facet_rep_wrap.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/facet-rep-lab.r +% Please edit documentation in R/facet-wrap.r \name{facet_rep_wrap} \alias{facet_rep_wrap} \title{Wrap a 1d ribbon of panels into 2d} @@ -36,4 +36,8 @@ vertical.} a better use of screen space than \code{\link{facet_grid}} because most displays are roughly rectangular. } - +\examples{ +ggplot(mpg, aes(displ, hwy)) + + geom_point() + + facet_wrap(~class) +} diff --git a/man/g_legend.Rd b/man/g_legend.Rd index 01dfbe0..cc00a40 100644 --- a/man/g_legend.Rd +++ b/man/g_legend.Rd @@ -29,10 +29,9 @@ legend <- g_legend(d) grid.newpage() grid.draw(legend) } -\author{ -Stack Overflow -} \seealso{ \code{\link{grid_arrange_shared_legend}}, \code{\link{reposition_legend}} } - +\author{ +Stack Overflow +} diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd index 8bc054b..bc6745a 100644 --- a/man/ggplot2-ggproto.Rd +++ b/man/ggplot2-ggproto.Rd @@ -1,13 +1,14 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ggplot2.r, R/coord-flex.r, R/facet-rep-lab.r +% Please edit documentation in R/ggplot2.r, R/coord-flex.r, R/facet-rep-lab.r, +% R/facet-wrap.r \docType{data} \name{ggplot2-ggproto} +\alias{ggplot2-ggproto} \alias{CoordFlexCartesian} -\alias{CoordFlexFixed} \alias{CoordFlexFlipped} +\alias{CoordFlexFixed} \alias{FacetGridRepeatLabels} \alias{FacetWrapRepeatLabels} -\alias{ggplot2-ggproto} \title{Base ggproto classes for ggplot2} \description{ If you are creating a new geom, stat, position, or scale in another package, @@ -19,4 +20,3 @@ you'll need to extend from \code{ggplot2::Geom}, \code{ggplot2::Stat}, } \keyword{datasets} \keyword{internal} - diff --git a/man/grid_arrange_shared_legend.Rd b/man/grid_arrange_shared_legend.Rd index 07538bb..717668b 100644 --- a/man/grid_arrange_shared_legend.Rd +++ b/man/grid_arrange_shared_legend.Rd @@ -45,4 +45,3 @@ grid_arrange_shared_legend(p1, p2, p3, p4, ncol = 2, nrow = 2) \seealso{ \code{\link{g_legend}}, \code{\link{reposition_legend}} } - diff --git a/man/if-not-null.Rd b/man/if-not-null.Rd index 286c121..6038838 100644 --- a/man/if-not-null.Rd +++ b/man/if-not-null.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ggplot2.r \name{if-not-null} -\alias{\%||\%} \alias{if-not-null} +\alias{\%||\%} \title{Return if not null} \usage{ a \%||\% b @@ -14,4 +14,3 @@ Returns second argument if first argument is \code{NULL}. Code taken from \file{ggplot2/R/utilities.r}. } \keyword{internal} - diff --git a/man/knit_print.Rd b/man/knit_print.Rd index 2bb08ca..f34aca8 100644 --- a/man/knit_print.Rd +++ b/man/knit_print.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/knit_print.r \name{knit_print.data.frame} \alias{knit_print.data.frame} -\alias{knit_print.grouped_df} \alias{knit_print.tbl_df} +\alias{knit_print.grouped_df} \title{knitr extension: Always use `kable` for data frames.} \usage{ \method{knit_print}{data.frame}(x, options, ...) @@ -42,4 +42,3 @@ data.frame \code{\link[knitr]{knit_print}}, \code{\link[knitr]{kable}} } \keyword{print} - diff --git a/man/remove_labels_from_axis.Rd b/man/remove_labels_from_axis.Rd index f12a3af..bcd3cf7 100644 --- a/man/remove_labels_from_axis.Rd +++ b/man/remove_labels_from_axis.Rd @@ -13,4 +13,3 @@ remove_labels_from_axis(axisgrob) Called from FacetGridRepeatLabels. } \keyword{interal} - diff --git a/man/reposition_legend.Rd b/man/reposition_legend.Rd index df9ab34..cf7d6ab 100644 --- a/man/reposition_legend.Rd +++ b/man/reposition_legend.Rd @@ -66,10 +66,9 @@ reposition_legend(d + theme(legend.position='bottom'), x=0.3, y=0, just=c(0, -0. # For using with facets: reposition_legend(d + facet_grid(.~cut), 'top left', panel = 'panel-3-1') } -\author{ -Stefan McKinnon Edwards -} \seealso{ \code{\link{g_legend}}, \code{\link{grid_arrange_shared_legend}} } - +\author{ +Stefan McKinnon Edwards +} diff --git a/man/splot.Rd b/man/splot.Rd index 72d7ac9..6496e09 100644 --- a/man/splot.Rd +++ b/man/splot.Rd @@ -4,6 +4,7 @@ \name{splot} \alias{splot} \alias{splot-package} +\alias{splot-package} \title{Stefan's plot package} \source{ \url{https://github.com/stefanedwards/splot} @@ -30,7 +31,7 @@ data frame using \code{\link[knitr]{kable}}. See \code{\link{knit_print.data.frame}}. } + \author{ Stefan McKinnon Edwards } - diff --git a/man/waiver.Rd b/man/waiver.Rd index 1713264..163e86e 100644 --- a/man/waiver.Rd +++ b/man/waiver.Rd @@ -1,9 +1,9 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ggplot2.r \name{waiver} -\alias{\%|W|\%} -\alias{is.waive} \alias{waiver} +\alias{is.waive} +\alias{\%|W|\%} \title{A waiver object.} \usage{ waiver() @@ -28,4 +28,3 @@ Code taken from \file{ggplot2/R/utilities.r}. ggplot2 } \keyword{internal} - diff --git a/vignettes/capped-axes.Rmd b/vignettes/capped-axes.Rmd index df90d37..b66b81f 100644 --- a/vignettes/capped-axes.Rmd +++ b/vignettes/capped-axes.Rmd @@ -24,7 +24,7 @@ A quick demonstration of capping the lines. First, load the package, generate a dataset and display it. ```{r load_pkg_and_data,fig.cap='Default ggplot2 plotting.'} -#library(ggplot2) +library(ggplot2) library(splot) dat1 <- data.frame( @@ -82,6 +82,14 @@ ggplot(dat1, aes(gp, y)) + geom_point(position=position_jitter(width=0.2, height ## Facets ```{r eval=FALSE} +dsamp <- diamonds[sample(nrow(diamonds), 1000), ] +(d <- ggplot(dsamp, aes(carat, price)) + +geom_point(aes(colour = clarity)) + +theme(legend.position = c(0.1, 0.7)) +) + +d2 <- d + splot::facet_rep_wrap(~cut, ncol=2, .debug=TRUE) +my.theme +d2 + scale_y_continuous(sec.axis = dup_axis()) # Facet grid ----------------- ggplot(dat1, aes(gp, y)) + geom_point() + From 3156a051cec7e951cf5b8576f6eeea4e02d268f6 Mon Sep 17 00:00:00 2001 From: stefanedwards Date: Thu, 27 Apr 2017 22:46:46 +0100 Subject: [PATCH 3/7] Cleanup of ggplot2 @importFrom; now must ggplot2 functions are referenced directly by `ggplot::` --- NAMESPACE | 5 -- R/facet-rep-lab.r | 104 ++++++++++++------------------------------ R/facet-wrap.r | 44 ++++++------------ man/facet_rep.Rd | 27 +++++++++++ man/facet_rep_grid.Rd | 75 ------------------------------ man/facet_rep_wrap.Rd | 43 ----------------- 6 files changed, 68 insertions(+), 230 deletions(-) create mode 100644 man/facet_rep.Rd delete mode 100644 man/facet_rep_grid.Rd delete mode 100644 man/facet_rep_wrap.Rd diff --git a/NAMESPACE b/NAMESPACE index 704b335..1038dbb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -31,13 +31,8 @@ import(knitr) importFrom(ggplot2,CoordCartesian) importFrom(ggplot2,CoordFixed) importFrom(ggplot2,CoordFlip) -importFrom(ggplot2,FacetGrid) -importFrom(ggplot2,FacetWrap) importFrom(ggplot2,ggproto) importFrom(grid,unit) -importFrom(gtable,gtable_add_cols) -importFrom(gtable,gtable_add_grob) -importFrom(gtable,gtable_add_rows) importFrom(gtable,gtable_col) importFrom(gtable,gtable_height) importFrom(gtable,gtable_row) diff --git a/R/facet-rep-lab.r b/R/facet-rep-lab.r index 7a80554..4b8563b 100644 --- a/R/facet-rep-lab.r +++ b/R/facet-rep-lab.r @@ -1,70 +1,22 @@ #' @include ggplot2.r NULL -# facet_rep_grid ------------------------ -NULL - -#' Lay out panels in a grid with axes replicated across all panels. -#' -#' \strong{Documentation is straight from \code{\link[ggplot2]{facet_grid}}.} -#' Only addition is this function \emph{copies the axis across all panels}. -#' \code{repeat.tick.labels=FALSE} removes the labels (numbering) on an axis. +#' Repeat axis lines and labels across all facet panels #' -#' \code{facet_grid} forms a matrix of panels defined by row and column -#' facetting variables. It is most useful when you have two discrete -#' variables, and all combinations of the variables exist in the data. +#' \code{\link[ggplot2]{facet_grid}} and \code{\link[ggplot2]{facet_wrap}}, but +#' with axis lines and labels preserved on all panels. #' -#' @param facets a formula with the rows (of the tabular display) on the LHS -#' and the columns (of the tabular display) on the RHS; the dot in the -#' formula is used to indicate there should be no faceting on this dimension -#' (either row or column). The formula can also be provided as a string -#' instead of a classical formula object -#' @param margins either a logical value or a character -#' vector. Margins are additional facets which contain all the data -#' for each of the possible values of the faceting variables. If -#' \code{FALSE}, no additional facets are included (the -#' default). If \code{TRUE}, margins are included for all faceting -#' variables. If specified as a character vector, it is the names of -#' variables for which margins are to be created. -#' @param scales Are scales shared across all facets (the default, -#' \code{"fixed"}), or do they vary across rows (\code{"free_x"}), -#' columns (\code{"free_y"}), or both rows and columns (\code{"free"}) -#' @param space If \code{"fixed"}, the default, all panels have the same size. -#' If \code{"free_y"} their height will be proportional to the length of the -#' y scale; if \code{"free_x"} their width will be proportional to the -#' length of the x scale; or if \code{"free"} both height and width will -#' vary. This setting has no effect unless the appropriate scales also vary. -#' @param labeller A function that takes one data frame of labels and -#' returns a list or data frame of character vectors. Each input -#' column corresponds to one factor. Thus there will be more than -#' one with formulae of the type \code{~cyl + am}. Each output -#' column gets displayed as one separate line in the strip -#' label. This function should inherit from the "labeller" S3 class -#' for compatibility with \code{\link{labeller}()}. See -#' \code{\link{label_value}} for more details and pointers to other -#' options. -#' @param as.table If \code{TRUE}, the default, the facets are laid out like -#' a table with highest values at the bottom-right. If \code{FALSE}, the -#' facets are laid out like a plot with the highest value at the top-right. -#' @param switch By default, the labels are displayed on the top and -#' right of the plot. If \code{"x"}, the top labels will be -#' displayed to the bottom. If \code{"y"}, the right-hand side -#' labels will be displayed to the left. Can also be set to -#' \code{"both"}. -#' @param shrink If \code{TRUE}, will shrink scales to fit output of -#' statistics, not raw data. If \code{FALSE}, will be range of raw data -#' before statistical summary. -#' @param drop If \code{TRUE}, the default, all factor levels not used in the -#' data will automatically be dropped. If \code{FALSE}, all factor levels -#' will be shown, regardless of whether or not they appear in the data. -#' @param repeat.tick.labels Logical, removes the labels (numbering) on an axis when \code{FALSE}. -#' @importFrom ggplot2 ggproto +#' @param ... Arguments used for \code{\link[ggplot2]{facet_grid}} or +#' \code{\link[ggplot2]{facet_wrap}}. +#' @param repeat.tick.labels Logical, removes the labels (numbering) on an inner +#' axes when \code{FALSE}. +#' @rdname facet_rep #' @export -facet_rep_grid <- function(facets, shrink=TRUE, repeat.tick.labels=FALSE, .debug=FALSE, ...) { - f <- facet_grid(facets, shrink=shrink, ...) - params <- append(f$params, list(repeat.tick.labels=repeat.tick.labels, .debug=.debug)) - ggproto(NULL, FacetGridRepeatLabels, - shrink=shrink, +facet_rep_grid <- function(..., repeat.tick.labels=FALSE) { + f <- ggplot2::facet_grid(...) + params <- append(f$params, list(repeat.tick.labels=repeat.tick.labels)) + ggplot2::ggproto(NULL, FacetGridRepeatLabels, + shrink=f$shrink, params=params) } @@ -91,12 +43,12 @@ remove_labels_from_axis <- function(axisgrob) { #' @format NULL #' @usage NULL #' @export -#' @importFrom ggplot2 FacetGrid ggproto -#' @importFrom gtable gtable_add_cols gtable_add_grob gtable_add_rows -FacetGridRepeatLabels <- ggplot2::ggproto('FacetGridRepeatLabels', `_inherit`=ggplot2::FacetGrid, +#' @import ggplot2 +#' @import gtable +FacetGridRepeatLabels <- ggplot2::ggproto('FacetGridRepeatLabels', + `_inherit`=ggplot2::FacetGrid, draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { - table <- FacetGrid$draw_panels(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) - if (params$.debug) { saveRDS(table, file='table.rds')} + table <- ggplot2::FacetGrid$draw_panels(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) # Add axes across all panels panels <- table$layout[grepl("^panel", table$layout$name), , drop = FALSE] @@ -130,19 +82,19 @@ FacetGridRepeatLabels <- ggplot2::ggproto('FacetGridRepeatLabels', `_inherit`=gg coord <- table$layout[table$layout$name == p$name, ] if (b_axis_row_added[p$row] == FALSE) { b_axis_row_added[p$row] <- TRUE - table <- gtable_add_rows(table, max_height(axis_b), coord$b) + table <- gtable::gtable_add_rows(table, max_height(axis_b), coord$b) } - table <- gtable_add_grob(table, axis_b[[p$col]], t=coord$b+1, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-b-%d-%d', p$col, p$row)) + table <- gtable::gtable_add_grob(table, axis_b[[p$col]], t=coord$b+1, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-b-%d-%d', p$col, p$row)) } # Left if (p$col > 1 & !inherits(axis_l[[p$row]], 'zeroGrob')) { # panel is not left-most column, (add column), add axis coord <- table$layout[table$layout$name == p$name, ] if (l_axis_column_added[p$col] == FALSE) { l_axis_column_added[p$col] <- TRUE - table <- gtable_add_cols(table, max_width(axis_l), coord$l-1) - table <- gtable_add_grob(table, axis_l[[p$row]], t=coord$t, b=coord$b, l=coord$l, clip='off', name=sprintf('axis-l-%d-%d', p$row, p$col)) + table <- gtable::gtable_add_cols(table, max_width(axis_l), coord$l-1) + table <- gtable::gtable_add_grob(table, axis_l[[p$row]], t=coord$t, b=coord$b, l=coord$l, clip='off', name=sprintf('axis-l-%d-%d', p$row, p$col)) } else { - table <- gtable_add_grob(table, axis_l[[p$row]], t=coord$t, b=coord$b, l=coord$l-1, clip='off', name=sprintf('axis-l-%d-%d', p$row, p$col)) + table <- gtable::gtable_add_grob(table, axis_l[[p$row]], t=coord$t, b=coord$b, l=coord$l-1, clip='off', name=sprintf('axis-l-%d-%d', p$row, p$col)) } } # Top @@ -150,10 +102,10 @@ FacetGridRepeatLabels <- ggplot2::ggproto('FacetGridRepeatLabels', `_inherit`=gg coord <- table$layout[table$layout$name == p$name, ] if (t_axis_row_added[p$row] == FALSE) { t_axis_row_added[p$row] <- TRUE - table <- gtable_add_rows(table, max_height(axis_t), coord$t-1) - table <- gtable_add_grob(table, axis_t[[p$col]], t=coord$t, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-t-%d-%d', p$col, p$row)) + table <- gtable::gtable_add_rows(table, max_height(axis_t), coord$t-1) + table <- gtable::gtable_add_grob(table, axis_t[[p$col]], t=coord$t, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-t-%d-%d', p$col, p$row)) } else { - table <- gtable_add_grob(table, axis_t[[p$col]], t=coord$t-1, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-t-%d-%d', p$col, p$row)) + table <- gtable::gtable_add_grob(table, axis_t[[p$col]], t=coord$t-1, l=coord$l, r=coord$r, clip='off', name=sprintf('axis-t-%d-%d', p$col, p$row)) } } @@ -162,9 +114,9 @@ FacetGridRepeatLabels <- ggplot2::ggproto('FacetGridRepeatLabels', `_inherit`=gg coord <- table$layout[table$layout$name == p$name, ] if (r_axis_column_added[p$col] == FALSE) { r_axis_column_added[p$col] <- TRUE - table <- gtable_add_cols(table, max_width(axis_r), coord$r) + table <- gtable::gtable_add_cols(table, max_width(axis_r), coord$r) } - table <- gtable_add_grob(table, axis_r[[p$row]], t=coord$t, b=coord$b, l=coord$r+1, clip='off', name=sprintf('axis-r-%d-%d', p$row, p$col)) + table <- gtable::gtable_add_grob(table, axis_r[[p$row]], t=coord$t, b=coord$b, l=coord$r+1, clip='off', name=sprintf('axis-r-%d-%d', p$row, p$col)) } } diff --git a/R/facet-wrap.r b/R/facet-wrap.r index e3b40a9..fce8393 100644 --- a/R/facet-wrap.r +++ b/R/facet-wrap.r @@ -1,36 +1,18 @@ #' @include ggplot2.r NULL -#' Wrap a 1d ribbon of panels into 2d -#' -#' \code{facet_wrap} wraps a 1d sequence of panels into 2d. This is generally -#' a better use of screen space than \code{\link{facet_grid}} because most -#' displays are roughly rectangular. -#' -#' @param facets Either a formula or character vector. Use either a -#' one sided formula, \code{~a + b}, or a character vector, \code{c("a", "b")}. -#' @param nrow,ncol Number of rows and columns. -#' @param scales should Scales be fixed (\code{"fixed"}, the default), -#' free (\code{"free"}), or free in one dimension (\code{"free_x"}, -#' \code{"free_y"}). -#' @param strip.position By default, the labels are displayed on the top of -#' the plot. Using \code{strip.position} it is possible to place the labels on -#' either of the four sides by setting \code{strip.position = c("top", -#' "bottom", "left", "right")} -#' @param dir Direction: either "h" for horizontal, the default, or "v", for -#' vertical. -#' @inheritParams facet_rep_grid -#' @importFrom ggplot2 facet_wrap +#' @rdname facet_rep +#' @import ggplot2 #' @export #' @examples #' ggplot(mpg, aes(displ, hwy)) + #' geom_point() + #' facet_wrap(~class) -facet_rep_wrap <- function(facets, shrink=TRUE, repeat.tick.labels=FALSE, .debug=FALSE, ...) { - f <- facet_wrap(facets, shrink=shrink, ...) - params <- append(f$params, list(repeat.tick.labels=repeat.tick.labels, .debug=.debug)) - ggproto(NULL, FacetWrapRepeatLabels, - shrink=shrink, +facet_rep_wrap <- function(..., repeat.tick.labels=FALSE) { + f <- facet_wrap(...) + params <- append(f$params, list(repeat.tick.labels=repeat.tick.labels)) + ggplot2::ggproto(NULL, FacetWrapRepeatLabels, + shrink=f$shrink, params=params) } @@ -39,8 +21,8 @@ facet_rep_wrap <- function(facets, shrink=TRUE, repeat.tick.labels=FALSE, .debug #' @format NULL #' @usage NULL #' @export -#' @importFrom ggplot2 FacetWrap ggproto -#' @importFrom gtable gtable_add_cols gtable_add_grob gtable_add_rows +#' @import ggplot2 +#' @import gtable FacetWrapRepeatLabels <- ggplot2::ggproto('FacetWrapRepeatLabels', `_inherit`=ggplot2::FacetWrap, draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { @@ -74,7 +56,7 @@ FacetWrapRepeatLabels <- ggplot2::ggproto('FacetWrapRepeatLabels', labels_df <- layout[names(params$facets)] attr(labels_df, "facet") <- "wrap" - strips <- render_strips( + strips <- ggplot2::render_strips( structure(labels_df, type = "rows"), structure(labels_df, type = "cols"), params$labeller, theme) @@ -93,7 +75,7 @@ FacetWrapRepeatLabels <- ggplot2::ggproto('FacetWrapRepeatLabels', respect <- TRUE } - empty_table <- matrix(list(zeroGrob()), nrow = nrow, ncol = ncol) + empty_table <- matrix(list(ggplot2::zeroGrob()), nrow = nrow, ncol = ncol) panel_table <- empty_table panel_table[panel_pos] <- panels empties <- apply(panel_table, c(1,2), function(x) ggplot2:::is.zero(x[[1]])) @@ -102,9 +84,9 @@ FacetWrapRepeatLabels <- ggplot2::ggproto('FacetWrapRepeatLabels', heights = unit(rep(aspect_ratio, nrow), "null"), respect = respect, clip = "on", z = matrix(1, ncol = ncol, nrow = nrow)) panel_table$layout$name <- paste0('panel-', rep(seq_len(ncol), nrow), '-', rep(seq_len(nrow), each = ncol)) - panel_table <- gtable_add_col_space(panel_table, + panel_table <- gtable::gtable_add_col_space(panel_table, theme$panel.spacing.x %||% theme$panel.spacing) - panel_table <- gtable_add_row_space(panel_table, + panel_table <- gtable::gtable_add_row_space(panel_table, theme$panel.spacing.y %||% theme$panel.spacing) # Add axes diff --git a/man/facet_rep.Rd b/man/facet_rep.Rd new file mode 100644 index 0000000..be4ca77 --- /dev/null +++ b/man/facet_rep.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/facet-rep-lab.r, R/facet-wrap.r +\name{facet_rep_grid} +\alias{facet_rep_grid} +\alias{facet_rep_wrap} +\title{Repeat axis lines and labels across all facet panels} +\usage{ +facet_rep_grid(..., repeat.tick.labels = FALSE) + +facet_rep_wrap(..., repeat.tick.labels = FALSE) +} +\arguments{ +\item{...}{Arguments used for \code{\link[ggplot2]{facet_grid}}.} + +\item{repeat.tick.labels}{Logical, removes the labels (numbering) on an axis +when \code{FALSE}.} +} +\description{ +\code{\link[ggplot2]{facet_grid}} and \code{\link[ggplot2]{facet_wrap}}, but +with axis lines and labels preserved on all panels. +} +\examples{ +ggplot(mpg, aes(displ, hwy)) + + geom_point() + + facet_wrap(~class) +} + diff --git a/man/facet_rep_grid.Rd b/man/facet_rep_grid.Rd deleted file mode 100644 index 4b3fd5e..0000000 --- a/man/facet_rep_grid.Rd +++ /dev/null @@ -1,75 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/facet-rep-lab.r -\name{facet_rep_grid} -\alias{facet_rep_grid} -\title{Lay out panels in a grid with axes replicated across all panels.} -\usage{ -facet_rep_grid(facets, shrink = TRUE, repeat.tick.labels = FALSE, - .debug = FALSE, ...) -} -\arguments{ -\item{facets}{a formula with the rows (of the tabular display) on the LHS -and the columns (of the tabular display) on the RHS; the dot in the -formula is used to indicate there should be no faceting on this dimension -(either row or column). The formula can also be provided as a string -instead of a classical formula object} - -\item{shrink}{If \code{TRUE}, will shrink scales to fit output of -statistics, not raw data. If \code{FALSE}, will be range of raw data -before statistical summary.} - -\item{repeat.tick.labels}{Logical, removes the labels (numbering) on an axis when \code{FALSE}.} - -\item{margins}{either a logical value or a character -vector. Margins are additional facets which contain all the data -for each of the possible values of the faceting variables. If -\code{FALSE}, no additional facets are included (the -default). If \code{TRUE}, margins are included for all faceting -variables. If specified as a character vector, it is the names of -variables for which margins are to be created.} - -\item{scales}{Are scales shared across all facets (the default, -\code{"fixed"}), or do they vary across rows (\code{"free_x"}), -columns (\code{"free_y"}), or both rows and columns (\code{"free"})} - -\item{space}{If \code{"fixed"}, the default, all panels have the same size. - If \code{"free_y"} their height will be proportional to the length of the - y scale; if \code{"free_x"} their width will be proportional to the -length of the x scale; or if \code{"free"} both height and width will -vary. This setting has no effect unless the appropriate scales also vary.} - -\item{labeller}{A function that takes one data frame of labels and -returns a list or data frame of character vectors. Each input -column corresponds to one factor. Thus there will be more than -one with formulae of the type \code{~cyl + am}. Each output -column gets displayed as one separate line in the strip -label. This function should inherit from the "labeller" S3 class -for compatibility with \code{\link{labeller}()}. See -\code{\link{label_value}} for more details and pointers to other -options.} - -\item{as.table}{If \code{TRUE}, the default, the facets are laid out like -a table with highest values at the bottom-right. If \code{FALSE}, the -facets are laid out like a plot with the highest value at the top-right.} - -\item{switch}{By default, the labels are displayed on the top and -right of the plot. If \code{"x"}, the top labels will be -displayed to the bottom. If \code{"y"}, the right-hand side -labels will be displayed to the left. Can also be set to -\code{"both"}.} - -\item{drop}{If \code{TRUE}, the default, all factor levels not used in the -data will automatically be dropped. If \code{FALSE}, all factor levels -will be shown, regardless of whether or not they appear in the data.} -} -\description{ -\strong{Documentation is straight from \code{\link[ggplot2]{facet_grid}}.} -Only addition is this function \emph{copies the axis across all panels}. -\code{repeat.tick.labels=FALSE} removes the labels (numbering) on an axis. -} -\details{ -\code{facet_grid} forms a matrix of panels defined by row and column -facetting variables. It is most useful when you have two discrete -variables, and all combinations of the variables exist in the data. -} - diff --git a/man/facet_rep_wrap.Rd b/man/facet_rep_wrap.Rd deleted file mode 100644 index a9f461f..0000000 --- a/man/facet_rep_wrap.Rd +++ /dev/null @@ -1,43 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/facet-wrap.r -\name{facet_rep_wrap} -\alias{facet_rep_wrap} -\title{Wrap a 1d ribbon of panels into 2d} -\usage{ -facet_rep_wrap(facets, shrink = TRUE, repeat.tick.labels = FALSE, - .debug = FALSE, ...) -} -\arguments{ -\item{facets}{Either a formula or character vector. Use either a -one sided formula, \code{~a + b}, or a character vector, \code{c("a", "b")}.} - -\item{shrink}{If \code{TRUE}, will shrink scales to fit output of -statistics, not raw data. If \code{FALSE}, will be range of raw data -before statistical summary.} - -\item{repeat.tick.labels}{Logical, removes the labels (numbering) on an axis when \code{FALSE}.} - -\item{nrow, ncol}{Number of rows and columns.} - -\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{strip.position}{By default, the labels are displayed on the top of -the plot. Using \code{strip.position} it is possible to place the labels on -either of the four sides by setting \code{strip.position = c("top", -"bottom", "left", "right")}} - -\item{dir}{Direction: either "h" for horizontal, the default, or "v", for -vertical.} -} -\description{ -\code{facet_wrap} wraps a 1d sequence of panels into 2d. This is generally -a better use of screen space than \code{\link{facet_grid}} because most -displays are roughly rectangular. -} -\examples{ -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - facet_wrap(~class) -} From 6fbc92ed7d2c848d711186461914a40f276b4ee1 Mon Sep 17 00:00:00 2001 From: stefanedwards Date: Thu, 27 Apr 2017 23:07:56 +0100 Subject: [PATCH 4/7] Added zoom for reposition_legend. --- vignettes/capped-axes.Rmd | 2 +- vignettes/legends.Rmd | 37 +++++++++++++++++++++++++++++++------ 2 files changed, 32 insertions(+), 7 deletions(-) diff --git a/vignettes/capped-axes.Rmd b/vignettes/capped-axes.Rmd index b66b81f..118ae9e 100644 --- a/vignettes/capped-axes.Rmd +++ b/vignettes/capped-axes.Rmd @@ -88,7 +88,7 @@ geom_point(aes(colour = clarity)) + theme(legend.position = c(0.1, 0.7)) ) -d2 <- d + splot::facet_rep_wrap(~cut, ncol=2, .debug=TRUE) +my.theme +(d2 <- d + splot::facet_rep_wrap(~cut, ncol=2) +my.theme) d2 + scale_y_continuous(sec.axis = dup_axis()) # Facet grid ----------------- diff --git a/vignettes/legends.Rmd b/vignettes/legends.Rmd index 93e9da8..d709e66 100644 --- a/vignettes/legends.Rmd +++ b/vignettes/legends.Rmd @@ -35,14 +35,27 @@ library(ggplot2) dsamp <- diamonds[sample(nrow(diamonds), 1000), ] (d <- ggplot(dsamp, aes(carat, price)) + geom_point(aes(colour = clarity)) + - theme(legend.position = c(0.1, 0.7)) + theme(legend.position = c(0.06, 0.75)) ) ``` -This is however prone to badly positioning, if e.g. the plot is resized: +This is however prone to badly positioning, if e.g. the plot is resized or +font size changed: + +```{r echo=FALSE,fig.cap='**Left:** Base font size set to 22 pt. **Right:** Zoom on plot that is plotted at 150% size.'} + + +vp1 <- viewport(x=0, y=0, width=unit(0.5, 'npc'), just=c(0,0)) +vp2 <- viewport(x=0.5, y=1, width=unit(1.5, 'npc'), height=unit(1.5, 'npc'), just=c(0,1)) +grid.newpage() +vp0 <- current.viewport() +pushViewport(vp1) +g <- ggplotGrob(d + theme_gray(base_size=26) + theme(legend.position = c(0.06, 0.75))) +grid.draw(g) +popViewport() +pushViewport(vp2) +grid.draw(ggplotGrob(d)) -```{r echo=FALSE,fig.height=3, fig.width=3} -d ``` With our function, we can specify exactly how we want it in the plotting area: @@ -52,8 +65,20 @@ reposition_legend(d, 'top left') ``` And it stays there. -```{r reposition_legend_small,eval=FALSE,fig.height=2, fig.width=2} -reposition_legend(d, 'top left') +```{r echo=FALSE,fig.cap='**Left:** Base font size set to 22 pt. **Right:** Zoom on plot that is plotted at 150% size.'} + + +vp1 <- viewport(x=0, y=0, width=unit(0.5, 'npc'), just=c(0,0)) +vp2 <- viewport(x=0.5, y=1, width=unit(1.5, 'npc'), height=unit(1.5, 'npc'), just=c(0,1)) +grid.newpage() +vp0 <- current.viewport() +pushViewport(vp1) +grid.draw(reposition_legend(d + theme_gray(base_size=26) + theme(legend.position = c(0.06, 0.75)), 'top left', plot=FALSE)) +grid.draw(g) +popViewport() +pushViewport(vp2) +grid.draw(reposition_legend(d, 'top left', plot=FALSE)) + ``` ### Facets From 3e3b0e5aad6074474c0b64b988a345bbdc07681d Mon Sep 17 00:00:00 2001 From: stefanedwards Date: Fri, 28 Apr 2017 00:12:49 +0100 Subject: [PATCH 5/7] Changed package name to 'splot!'. Added lots of documentation. --- .gitignore | 3 +- DESCRIPTION | 3 +- R/splot.r | 38 +++++++++++++++-------- README.Rmd | 54 +++++++++++++++++++++++++++------ README.md | 36 ++++++++++++---------- README/domain_axis_lines-1.png | Bin 0 -> 207 bytes README/domain_facets-1.png | Bin 0 -> 208 bytes README/g_legend-1.png | Bin 10282 -> 1452 bytes README/reposition_legend-1.png | Bin 0 -> 9119 bytes README/reposition_legend-2.png | Bin 0 -> 9119 bytes vignettes/capped-axes.Rmd | 47 ++++++++++++++++++---------- 11 files changed, 126 insertions(+), 55 deletions(-) create mode 100644 README/domain_axis_lines-1.png create mode 100644 README/domain_facets-1.png create mode 100644 README/reposition_legend-1.png create mode 100644 README/reposition_legend-2.png diff --git a/.gitignore b/.gitignore index cc40004..12ff8b4 100644 --- a/.gitignore +++ b/.gitignore @@ -7,4 +7,5 @@ inst/doc -/lib/ \ No newline at end of file +/lib/ +/README/cache/ diff --git a/DESCRIPTION b/DESCRIPTION index 97d38fd..5ce4494 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: splot Type: Package -Title: splot - Stefan's plotting package +Title: splot! - Stefan's plot library of tricks Version: 0.2.0 Author: Stefan McKinnon Edwards Maintainer: Stefan McKinnon Edwards @@ -28,6 +28,7 @@ Collate: 'coord-capped.r' 'coord-flex.r' 'facet-rep-lab.r' + 'facet-wrap.r' 'knit_print.r' 'legends.r' 'splot.r' diff --git a/R/splot.r b/R/splot.r index 61e5634..ba9a903 100644 --- a/R/splot.r +++ b/R/splot.r @@ -1,22 +1,36 @@ -#' Stefan's plot package +#' splot! - Stefan's plot library of tricks #' #' Just another ggplot2 extension. -#' +#' #' @section Functions for axis: -#' -#' See \code{\link{coord_capped_cart}} and \code{\link{coord_flex_cart}}. -#' The latter is a shorthand version of the former. -#' It automatically uses \code{\link{capped_horisontal}} and -#' \code{\link{capped_vertical}}, but both accepts these as well as +#' +#' See \code{\link{coord_capped_cart}} and \code{\link{coord_flex_cart}}. +#' The latter is a shorthand version of the former. +#' It automatically uses \code{\link{capped_horisontal}} and +#' \code{\link{capped_vertical}}, but both accepts these as well as #' \code{\link{brackets_horisontal}} and \code{\link{brackets_vertical}}. -#' -#' +#' +#' @section Legends: +#' +#' \describe{ +#' \item{Extract legend}{\code{\link{g_legend}}} +#' \item{Many plots, one legend}{\code{\link{grid_arrange_shared_legend}}} +#' \item{Place legend exactly on plot}{\code{\link{reposition_legend}}} +#' } +#' +#' @section Facets: +#' +#' \code{\link{facet_rep_grid}} and \code{\link{facet_rep_wrap}} are extensions +#' to the wellknown \code{\link[ggplot2]{facet_grid}} and +#' \code{\link[ggplot2]{facet_wrap}} where axis lines and labels are drawn on +#' all panels. +#' #' @section Extending knitr: -#' -#' We automatically load knitr's \code{\link[knitr]{knit_print}} for +#' +#' We automatically load knitr's \code{\link[knitr]{knit_print}} for #' data frames and dplyr tables to provide automatic pretty printing of #' data frame using \code{\link[knitr]{kable}}. -#' +#' #' See \code{\link{knit_print.data.frame}}. #' #' @docType package diff --git a/README.Rmd b/README.Rmd index 4876bee..800a00f 100644 --- a/README.Rmd +++ b/README.Rmd @@ -8,15 +8,48 @@ output: github_document knitr::opts_chunk$set( collapse = TRUE, comment = "#>", - fig.path = "README/" + fig.path = "README/", + cache.path = "README/cache/", + cache = TRUE, + autodep=TRUE ) ``` -# splot - Stefan's plotting package +# splot! - Stefan's plot library of tricks Just another [ggplot2](http://ggplot2.tidyverse.org) and [knitr](https://yihui.name/knitr/) extension package. +This package contains functions primarily in these domains of ggplot2: + +```{r domain_axis_lines,include=FALSE,fig.height=0.5,fig.width=0.5} +library(ggplot2) +library(splot) +ggplot(mtcars, aes(x=cyl, y=mpg)) + + geom_point(size=0.1) + + coord_capped_cart(bottom=brackets_horisontal(), left='both') + + theme_light() + + theme(panel.border=element_blank(), axis.line = element_line(), + axis.title=element_blank(), axis.text=element_blank(), + panel.grid=element_blank(), axis.ticks.x = element_line(colour='black')) +``` +```{r domain_facets,include=FALSE,fig.height=0.5, fig.width=0.5} +ggplot(mtcars, aes(x=cyl, y=mpg)) + + geom_point(size=0.1) + + coord_capped_cart(bottom='both', left='both') + + facet_rep_wrap(~carb) + + theme_light() + + theme(panel.border=element_blank(), axis.line = element_line(), + axis.title=element_blank(), axis.text=element_blank(), + panel.grid=element_blank(), axis.ticks = element_blank(), + axis.ticks.length = unit(0, 'npc'), panel.spacing=unit(1, 'mm'), + strip.background=element_blank(), strip.text=element_blank()) +``` + +* ![Axis lines miniature](README/domain_axis_lines-1.png) Axis lines +* ![Facets miniature](README/domain_facets-1.png) Repeated axis lines on facets. +* Legends +* knitr ## Installation @@ -56,16 +89,20 @@ ggplot(mtcars, aes(x=as.factor(cyl), y=mpg)) + ## Legends +Reposition the legend onto the plot. Exactly where you want it: +```{r reposition_legend,fig.cap='The legend repositioned onto the top left corner of the panel.'} +dsamp <- diamonds[sample(nrow(diamonds), 1000), ] +d <- ggplot(dsamp, aes(carat, price)) + + geom_point(aes(colour = clarity)) +reposition_legend(d, 'top left') +``` + Scavenging the Internet, we have found some functions that help work with legends. Frequently appearing on [Stack Overflow](http://stackoverflow.com), we bring you `g_legend`: -```{r g_legend} -dsamp <- diamonds[sample(nrow(diamonds), 1000), ] -(d <- ggplot(dsamp, aes(carat, price)) + -geom_point(aes(colour = clarity))) - +```{r g_legend,fig.height=3,fig.width=2,fig.cap='The legend grob, by itself.'} legend <- g_legend(d) grid.newpage() grid.draw(legend) @@ -78,7 +115,7 @@ brought us the ([original](https://github.com/tidyverse/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs)). We put it in a package. -```{r grid_arrange_shared_legend} +```{r grid_arrange_shared_legend,fig.cap='Four plots that share the same legend.'} dsamp <- diamonds[sample(nrow(diamonds), 1000), ] p1 <- qplot(carat, price, data = dsamp, colour = clarity) p2 <- qplot(cut, price, data = dsamp, colour = clarity) @@ -116,5 +153,4 @@ See `knit_print.data.frame`. ## To do: -* Implement `facet` objects that repeat axes * Describe coord objects in capped-axes vignette. diff --git a/README.md b/README.md index 4a98607..a0017d2 100644 --- a/README.md +++ b/README.md @@ -1,10 +1,17 @@ -splot - Stefan's plotting package -================================= +splot! - Stefan's plot library of tricks +======================================== Just another [ggplot2](http://ggplot2.tidyverse.org) and [knitr](https://yihui.name/knitr/) extension package. +This package contains functions primarily in these domains of ggplot2: + +- ![Axis lines miniature](README/domain_axis_lines-1.png) Axis lines +- ![Facets miniature](README/domain_facets-1.png) Repeated axis lines on facets. +- Legends +- knitr + Installation ------------ @@ -25,10 +32,6 @@ We can display a limit on the axes range. ``` r library(splot) -#> Loading required package: ggplot2 -#> Loading required package: grid -#> Loading required package: gridExtra -#> Loading required package: gtable ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point() + coord_capped_cart(bottom='both', left='none') + @@ -53,26 +56,28 @@ ggplot(mtcars, aes(x=as.factor(cyl), y=mpg)) + Legends ------- -Scavenging the Internet, we have found some functions that help work with legends. - -Frequently appearing on [Stack Overflow](http://stackoverflow.com), we bring you `g_legend`: +Reposition the legend onto the plot. Exactly where you want it: ``` r dsamp <- diamonds[sample(nrow(diamonds), 1000), ] -(d <- ggplot(dsamp, aes(carat, price)) + -geom_point(aes(colour = clarity))) +d <- ggplot(dsamp, aes(carat, price)) + + geom_point(aes(colour = clarity)) +reposition_legend(d, 'top left') ``` -![](README/g_legend-1.png) +![The legend repositioned onto the top left corner of the panel.](README/reposition_legend-1.png) -``` r +Scavenging the Internet, we have found some functions that help work with legends. +Frequently appearing on [Stack Overflow](http://stackoverflow.com), we bring you `g_legend`: + +``` r legend <- g_legend(d) grid.newpage() grid.draw(legend) ``` -![](README/g_legend-2.png) +![The legend grob, by itself.](README/g_legend-1.png) [Shaun Jackman](http://rpubs.com/sjackman) [originally](%5Bhttp://rpubs.com/sjackman/grid_arrange_shared_legend) brought us the `grid_arrange_shared_legend`, which was furhter refined by `baptiste` ([original](https://github.com/tidyverse/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs)). We put it in a package. @@ -85,7 +90,7 @@ p4 <- qplot(depth, price, data = dsamp, colour = clarity) grid_arrange_shared_legend(p1, p2, p3, p4, ncol = 2, nrow = 2) ``` -![](README/grid_arrange_shared_legend-1.png) +![Four plots that share the same legend.](README/grid_arrange_shared_legend-1.png) Extensions to knitr ------------------- @@ -126,5 +131,4 @@ See `knit_print.data.frame`. To do: ------ -- Implement `facet` objects that repeat axes - Describe coord objects in capped-axes vignette. diff --git a/README/domain_axis_lines-1.png b/README/domain_axis_lines-1.png new file mode 100644 index 0000000000000000000000000000000000000000..45f8f745203e9072d30cc9eee42bdce6c24f78f2 GIT binary patch literal 207 zcmeAS@N?(olHy`uVBq!ia0vp^1|ZDA3?vioaBc-soB=)|u0VS8=FR{A|94lm-3byb z@Q5sCVBk9p!i>lBSEK+1b39!fLp(Z@6O;rEda@K8nU$55nVAiDO}x@$!@D3r$;omR zuS&K=%RIRhzeO?3dUsQ@4|qtekP@(&AsMY waKO<}LF7_6vkH6SVhMqn*#hBR&XLRvGI;_QwQn0Z0qte*boFyt=akR{0CDp?!T3(O|o7t)9Oc$80Jo5OHRETSm@u#-k^AU893y85}Sb4q9e04s=0 ANB{r; literal 0 HcmV?d00001 diff --git a/README/g_legend-1.png b/README/g_legend-1.png index a7cbfa937cf8ed4f36075af53390b73bcb5e8ba5..e9327602dad21d0e4eb558702e562f358b27cda7 100644 GIT binary patch literal 1452 zcmb7EeN>WH7{BieDxo-ZQLLGGYL-K{G|LaPB+FwY8Z|)rl(gYTnubfQ*?MEyOij^d zwRFO1tJy*nbCi~1W}21ZndV5)X-6wlO4u|zlJ8#JKkJ>39p6CAV^PKy9oqLiK z6;2{9A_4$Ntc@GCVzL!oT;LG@}BZO=wK z&j7uYp-1(46g8X8(-|q~o(Gs6s+U?#tT1MXaWt7;u^)?QUfRZO=>Rz1wr;3BwQ?^2 z_!icNb=<6SV?QbV_f7NLOy8S(>C-URlWVVnx9DD>M#GwjKKFUNKhnj5r*E`|J%<~Y zTFyr{pPuydJ$W`!gP3nOLZ0w>C@IK#$r-@9@Hl9 z&C_eQJsWyD@XhM&x|o%R&W`+$qyke{m5)y?cN}zO4;=D3;X2ILKm6(K=4CEgZjlW~ z`Qgm;SVzc$+a110^0lHlaIopl=aOWjbHjy&yJ3U5c>B6>q<=bT*3u%QrD|AJZd2}c zjp}^~I|AXE$KjVLt(nd@j=D52MuzN>sHD^JTRn5pl?^rV&1X$N<8{^jD;zHJIT5m) zR^_@B$Xu*T?YEUv8+>k${zaKzB?b-(@8 zdN&81)Th?LNB8;Lk%c2c0aqxJ&<#m3J7P@DABfq$6!Sz2s%cfk&NsVsO5LwCR z$hKX)yRz2MkJt8P(I%cTE9xJEMfXPYnhPl+riMmv zIPzEL?Ec+R(fAAn0XLqXnJaF15<8$;;*hp4_e`-&Nu6En+42l|J9ShOl--_ay822` z+*I%~WR0#{UalmJ3!IM9?uHadMu})4^Okk%dmejF|IjC{BoA-)1N`0hf3nEr5xt55% zQ^*_kt0Ks7BZ9E~-J62qD7PX#jRicse^uQoezCqzk{L@xrh&Y~&f~;?Tjn*`Bgip{ z-2H|1J5Pkm4=Gye6LUVQ*=Y->Ct39{YMNLfRz_430|NPh(acGgfYtoK80O^4KCFp^ zt^mHzr_lK}`Z9OqD`1^ZBqIQxn+9vadPd;q;nCN3l)xctTiZ#xWIrA7iuKHu--@%#HXkD14v`?{~!>zsSe^PJato%4z&ni=qN;kf_+ z;59NlaS8x12mpXzI9SjY!YO$ydYK@aTIiuy08j-0S3orZaIFH0Hi1Sr;Ca*0qeszJ zRX|l0a8*@BzX_@dg9PTsn?Q&oc$X03-nwoLb47cgpM(V0s!jBnH^JMR5a;b(;$1R& z^$`%a)jN(57x#8EK@~_~PK5SVO{hvp7_3Sd+$`}XlrVe8mAow}8QrXM1*!%Uss=Z! zHV3OVH(Rc5zKtWi-P~+X1qKsT(dNO;!NJYV(Gu^`&CSWl$+@|?#nDl-YfAbJMu-PyqU_oEHtP{QzLwYvvDZ@u4~cz+S-UgtkS{y{Rnj z%)zRZ8weN^2)3X7>M<}qEe;mRL>x6ZqCSp7;#7}p=LL6@5;4~ zZ=JVZrR(aHU5{An-5JjHvG;)w5PpLd%FSc@U%zHHdTVKJM-WfJW0?DL(mf1vG122? za}(vN21~zv`!*}$XP*0qyR?AB zZS=s&{R=@q`M98OVhWuAoRoth>bl3@B_DBux}Au?#Dhu$Q>D8{5qCM(%v;*mk{549 zW23t63`f;3IQxOnPM)^=?65Bf{Gp!>U&|0eNG!O|Ebqj3k4^ z8pEesgd1uouIkqwnQtj2*c~@@`+lt^n}ALwK!0Ed(6m9CNj-o>U=ZBp>mvS!fS}x| z!*_R}iXPeD8_v1U=C3Ic85=2Ww;wvqr7r4!2JW__r#^pD)6mc!U=Ad|Mr4BzUOdkd z95P9e+Tu+0Ab^+sUOAa<$Dzp`w^Z;|P?a%THrs{lE{8YZoUi#d8dNek=^M}^r3H#v@b9B0d0xW zC9Fzqdb<(rV?gpt#5CBLP3b)ctSFLf)FCM6=!i1?dkd1JTigN$0DcL*Ia(n3oSS0M zglx&kA=snY+h7-`R5dpf9kh4#bWekKKQXZJ0}aQ#m$sm#gquASqCic<9{}3U9U(!= zcRk@a_OwR10Y@B4>HTh6q)3lWSN@f4kbt7Z=X2Are*NP_R)odzZE{dVI%dG`i0uyK zmNxsIzk1F+f)Ccy_qO69u+~TRo#18~hU?KQl%phoS{=0~$4d&_GBt!4Jm9eXrmi=R zMG^1xM}fxd3m3_pqMwYUyPD}1SAk$Ga&4zL9^N*khg%ZNr|1$(JhtLyVi9tpG!+Lejhq|@2Zykg zh4tzB$q@MuSvbJ>(5PpGAud$-WJS6ZWxo^cH0J&Mots~mwrgpqYi$I;m;l1+E@cLr8l%B)T9m4^6nVsXC1A58GSQFB3XDdc5lH6`5LEYh2 zAj?8y)V#grCW14#4h`2M6 z)2AH1lY+!+rI75e?~|hd{M8Qz*@^d+aGC;U=}eQZsJ+WULrQ&g?ScsXZcMkd8>;d^xuy|om^A8G~jP9w`HgEwQud4Z|*7MMUn2Z4|eqt*V_$j{{wqY z7<-GU*BpQh|8*37x*t2X1BjwnYypkwhD5Z#F?>RQHf**GUwyf?9w>zC>v9iK&d;WZNx$OChE@OH=rzHME$2361 zQeuhrxRcnZnu~K+#@82rvw+l~<63LWX?>S3oMWqy*ZTdycn*LIY<6#B2UPDxrao#Z z=?nX9^SrTf4FN5lto6$SN}W2>rtA>=9U8x$Gt0!g;+Rdt@FGyCcP)r_JJfO?%sQkY zP$R;=FtrgM>iNRcUTZC97B2?J8O=;te>FU{&w3JiMg8g!da8F;UQL3&X0UnO{xu8j zWKn|#_ioC}nPpEG#ef4w>jH2LX2F}A>Zz2KV;9@^3sB0TM1zch(x0b>Otnt)(f7<~ z(O|2YX7sI*|jGd!y&BK)+=_EOfZ=BuIN@ z$Ma!D_M7xSD&iR0m+Y&cexdR9Lzh3Q-5(_IOB~v;YBA@c4;!(CZvjA%*s-ApFufyD zH(Nmp5amPB#!5^T>FLA3ai}U&G4%U#J0i9*t(E@Fw&pH?kZf3Ynfme&=xsqvXG8&d zhEDiey%{m*dsfYXy7pujmI?0<53#i1)LVVFd_cy#bCdg%If=&wTn@sY|NeUcymp15 z0Jv0gDAxq=wXu*j(#oQ>uN`mTKvYx?=5o<;v{qS+iDr~@5ofuHP7|UgJjH5lNml{3glY=`510PYz0fKxIX+_Y)?dRPG7A(l$$NC zy!ar-d_^YLqVN6iPCFqa4;Wi_s88Tu_$k*bVnVZ#J3SN=)*wMvpIgwdImvu*>fE)Iw8)?5>T&Az>AExfexv!3nDI>C;WxU=yt z+*Z^kl+inBa>=5rgGEmYXt+<2Lq2zZU$+y-JA(@w`K#-!%7ymHd4N*y{&FGn3lHG7 z3YX>)KYrR${EfJL5ZP&Wd#3#FXzeskvOG40-ypE9`1kKGmy7_Ve98;Li!^-1qRp)0 zuZR0P>V&keitPv5>95#{2lR5y6|%(ziTyEUyNvS312D9Ea?h4MyOLK0^Nn=Clno?+ zXZ5EsN9nRZ#Z>MiCm9ClE@%wI2hzCf4WqSR-<)B_3JND_u5FHhSNZ#f>t4rLfVT6*iPI&I1+|`doy+V8 zU|*5s)!vVAa7uQ$obN7XxW_5G?WQggb$2P3n}{Jg3JSvf7{p$6w+^S5+Xo|vv1`M) z{Q!tW0@T!l3E~QPVnEl;H&0&*!@*pzj618lpcB};8$$##$O=4UXPybH|BwQ;{AbY5 z%I!e05{7)Ao0Cc>%)CJ?B-b3lQn3L{&zV5=;0Xnw7k^v38<2PtLOtJh4yU4`!nf4q zt$?LIJZ1{Ty0qjMim}k1$%*Hr11UEv_5T*A);oeMK5?>`l@%_R!}Cuee!cL(yEssa zqE|^t?U2hYlKYNfDyWOu7_V2%9WRt^6003j8syin01&DZ+6(x>!{QerK;=|X7Mee$ z?wfRf^D_TvFW@1ohDCk|o5HR~q?+{pLO=|X@5ts)=2r(KSfQ3?{)mrwTYXj(%e1R< zx2OUzhGr@}B1a8W0|+b&{k^>rZj2*6ZQv9kd>r(5n5~U(ki=3@qe^6>cjTw>U6vD$_5f_N4{vPPg#2?GD+{z5R#tzk{0Rnj%a^e9 zT;{tcKve`Zt=P746J11J^ z^T5&dR$N$-G3~OJx{!qQ$`e!QrXx)piUP>8h@)^%Z%RX9!?|DWD)Jv@8pBK*EsQiv z1?g3Q*Rf2)cQNK={z5qm>_Ry`E}Z01jTEYTT{MIEn@BFK*7}0ikhi4$cP_GD zmKjxAKrUgKoMg+O?BUI6gND_h zUrkQ+dltUURtTJCqrQ|HadeJbzY_HNUTE342T=M&Fkzy%MdyP+yuq4w+BWJT>`(xQ zm#xy7xKc$7A_wV-%9pGJGiI;Qo4)m$RqyiJbsRM;Rz$Ux18EScl+oOrxm?_o{Bj&B zZLoo^@jt-Ci1c)}FZ_PKX%m%;4*U|`!i)G8+*0rN3p!fp0!;K*_rz+KEMZe$U&UrW zyk;YSjJs{l)|RgZp(FxQk$nvdTwU`tURkgwfH7rIZ~JK&h_-v(08 z%#92k>itYgpol~~{!~Nd_t(3lcR%W7p&HhbkS~HO9#*1fW9&|dyvNa$3DpE~7xK>LO6Z{G4yWexH{-e-jnP6115M%FFY-^Jf>OO@p$Mi{864#2yjp+1B<)3H6{zp^1!y0he0wPn50cIGgH)gW3_7u4PfL`W;|Isc%}c

0EuUZMEpz2f@&TII&o<&aKNW9 z$bosC0BP0fSDHE8Foq~hDNlcQ8;(2t%NCEwVi0fW5VANZ4jtBEIQXVMG+_~xkh&SQ zi{|<*iYiiRPF*EU*X@D%Z8VS=V&3Z0%h==WK8D;7>Yk&3di{$TLD~o_+pCFMAvo)Kl{q> z??3nEhkr;&rY|Yr$MLQx7kp&>Td#x%tiA8zu5Ht>KZ@8f{;F&6;$%an#Sg%Xj>Lwa zpT=q50x-sAn5hW=vvvUT&FBp<6>tAsJ6(&NL98bxwd9{oS!e?nZ<|_8q2k znbKj4YN(Ilu-M5A`6S5Cngb7kDMwaCSMV&&rKNc{2XeOj zW@#V@{Se;<(#YJ(&f=|q^Mb`m?l=_ZcN3ZM_QNQUzBk7XT2mEU%RKT_B}zmPeq-$q z1W1$&o@9Z=Zi2jn*ZEK+N+X38dej3ahq`>6XpJ{O-oFo^(G3dFg^Wd;0Fz;M;%WgP z#Yw%;uW;p4iwzjy6X;}{3S05!jfnJIBLS5kM=m}#CIQhA2a!02LEN-qmXOZvBqH?mY_BL?%-{oiiWAmmhL?73ySd ztQ9!=aG|P{M4I4)XU?)n38-<5lnYSRqIH3uzC4u?vlpLo2`t5&Q*s8HYnQWEhXfdAlO611b<)D9$ZlhTLqY~wDz)bQN@3#(TR5=Fjy^A~nXL8Q7&V_aK#HU> zhM497MPJxY-~CBs^gdV`_8|q$5dt)EZr^!{=ECiW0V->8ERiqbGl)pyY1i_#A@j39 zj7aj!bCrob4fkgSpLbs^ZZ_o2sbEG*`S7XIAbaS4Ws1_if)YJ*Mm*0cxCXpYDp>f}xd*=fXGMa?^?xpErgEh0eEA=Idwn z49fSmxVYVos3OAKp2=r}zSa>#O`|!))yZ)&H4Z;vC(r_rTe{T zXUm5vf5w#k-1*k)9y=FIzvPKPCKT=0z|gKfi`k;#>DYe4L8N_M;$)_pXiZ+HB0c>@ z^B5@fbmgX&*2b^y>VWy7tI}dL*Pge}3h?6-#f)-Ja%M21dHHILXsV>FHY(h(*_uHx zcqNorCSp<9Q4b$`;Gs)xy}L0j$WEqjduKU;hU$4^@#3um^&~hDoPs`%UAb@4Y6;%} z@a0a+KfYR*+!^iR0)%AS93FbyV@)oe>ut$ZVS}zzUWFLezC%zqUcVSr4$cauOoaQ$ z)ZAc4lC1#p(26(dv`W%#Z*e>Lm>&6a<^;EbROuLtjPy^`ucy~dDitLi?I0X(W9GX* zvd~-QAYN!t-z=x&dj&H{X6Cj^*@$Zyc=|(d>SX|GmK5!Kt^!xxNxC4)3wi0Vd$$d_s|J(Q(FhJL z6nvZmQ@BSLCoVf#&3T*S5XoR)!{KIP_3uxFSrNgn%u2vJ_8z>SimL==#JnP_$E*JG zn>Qd;&B&}BNA&A6ch~l$?R5r=?*qzq0Ubk~C4+{_ z23~x%24p8Gx_wB{k(eT0m=p{gxv1;y z*_+a#KKL0x>E%{4cH!b*WU1cU5{#0phipX5z_#b_k^+YJdh{-~cPtl5MWXhP=AJJ! z!fnb~Tr|H3m!oyggx{VAKcx%YU2NZ8UwL0O{X290Me}D*cR-mXZ_bYtxa)z-0738U``&-_S`+Gy6@r{&9TN_=C{)qkeV1C?b~ z+6zqRRbXY7pJ}@~7OCBO(`mShjU4u17m)RaDV8?uf^*-mV@NQkEic_(PP>|U6SeiS4*w{)%npdq5=p-xpULs z#wqCl$=yu;$5@K7M?yr+)+XBQy*}*?9#KY|LW0qhof%UoLOfKi;};;GsD~C$OojXs z8OP3jZ5ALlA@`WoN*Nq6L{XHNtZ~*}PR)up@X7F<7v=xHeKVWXb8+NrT1>}$?JJTe z?c7^T<*SMnq|SL$!aCRdVha%~WEUP&Ls~jK6nMF;M6+~Uy7%e?DW2mb-}v#$q?`-0 z$F}@h3W^*1ivESrkFf};+xCU$)=>*8vJ~lP$|huy^LRLM$!+ zRW~QSXsqHoKRm~*`IJaOmTHC~o*{7YO2A>ngSBX^o0G~9upvh2d1oj1i3(bcB>3YF z52%+TNyY%Ak1?&a1cD^OJkH+0cT5zP>)nmf9y}k^`FfNEO|$_S$FeX-SG5a zTtRK<(|23GaSj;z1jo=wa#GXT3J0v3XL^#pA_E%V3;y*Bmg2}+zZrAikO3~^r-t4$ z%E!eS|M%fug#TS|cY@s>nybz&`{sT?wXWCg6`?)tk0U7A3t6f($Q+v_c;O+2^D4dt zOCza;6jkK;$&wmKZ}1OWw!j81RAuk>RSeAP8{dVeB=(FbeAN>~CXz0Kko?#dW`N?n z4`N8jAJuwIOS)MUQ3pnzl;YTsP zp#Xp#V4ej)p(g>@#P5xEBw=J)J!O`!-T6t*$+T<9#v-%9LmYzdK#K25u4`w;Xx zrEIy}slLep+ka*<$;GlT3R06i8dMa>cmHFI=!`9B-r16OIM8oEyMQnI1LL2G>~<5C zum2F|6v9;nOP71@+xhMmJ6_vw;~y(d!&+F)RJT9kQBJ{_t_)h0`Sl%5`|79Ai;?@= z$akU(_C6LvT=6ahE!{jWK-ECyIi}gw9YHd&#N$@ZKr#1+0&zCvK^=4Dk^oD`Lq5VW z?g53~qt<;3jJRV-v`AZV+3@eO9n3J0>B~HzSYFSCNM~z!8vitZDx~4k+fYw!1B=F+ zrK@+DVKsB6COG4)tZ2sZ`FguFbAirj)3F-cpJxH$L8fd7+;lG%dTys{{Q*#8nsIVK zw)RssfS587mLW(Rj5t`SKTq7V^r+t=%d|fK(O6N|gri^LV~D5CiRsg%K_T^zk!=Ls z6YZhogHb*8{crKt9LjDEPK&zj)*EvyX0xq9gPBNJ%;LKA%EM|>&&^9yOE(KB_AGUm zeNN-

O^vj+iBpNSHc}w?m#)#RV#$mnzhJUbOg<^O6kj$Cm%dR{&Gz^^t$L3Vm5k zWu&DbP6ZV8?tK5Rb_g8w8?64-gLh#oskYLIx^MbGr7cs!8C*m^l^YwSmd!J~kX~0t zlT#TQF-2{O`2=jN+H5lt>~y6w0k<*V?kUmi#w)SXvLixxl8I6hP*;X4H{m}d+pCmN zXH@1EMSnbh_YjVB_{*y-@xp^Z<#&>3Yk6mPibc*H<)7Oiw;#-5E8tM;HP2(2XYJB_ z0>EJMqWMGiSc}(E>j|a(|Jvy@cp`f5F42f8yPSaPYYoqznLS!*Qn*;*%arRw*jp9~ zxX|ET>odsTBc^~s{QQ{h?!b@?GMK? z{iVR*bUq*}jR}k~cK?z%6;&^Z+``Z558QqKL9vXF%ALOxw8Op!d`xxAHuV8<)8faK z$8HA?S5z?zYbdeFE;Y(yk@t)L7>xw5x>b^1*u^|MG4K2GWiDwJMk~I|)bpyS+n>`U zVCRD%Xn5n-!ut2g!ij%czwGPGMO*)=I`{hISbeQOz@aF(on8`xC+_>O`BX}Kd@TIt ziJN~Jqql#i*Ui&KtIOyy548D|&FpZV&~{v*BdDh(WlI%59+fEm?-`Q+uI8c=6#gIO z-T!X51hy4PV;3cVfjD$)dGV4v4n0`%-xnD^B8SKSK1gKAk4&+4kN5SVnRZblG3f@b z7a1QiTJ)+~g619i`nHex^k?S!M&O<)Ooy8ZL|l<43g5(h7rt ztIZReU21;*egiqaM|Z*0iZ|_^`T3f+D=xQ7#G!puNq|cTJ!tj+__aL>Tc7H>{8$_$ zdN=%Tk56lilHi1Wx#1^V@EiI@eo2X1@8o3t>C>mt0})}1YbEhvMZ>qy|Es@+#Q}Wo zQvCG2;m=`vH?wj$l@8ftsz_-cXM+yh-?=_s#>niuyhp?bkSYYok@lhMl;5Sry;@zS zHa>gBKpKZTH2is!-cmrT{0!M*5WX&+#`XKfA03Kyx`SCRal-nBN=Z%6)AHUwD*-Ki zoSito@&mDn)2^$vT&kNvo7#5dVwK*>ER*5k@c)gK|2}}m*i>%X_AI4s$sIig2N>y@ Lop_{kF8u!hQ|x?F diff --git a/README/reposition_legend-1.png b/README/reposition_legend-1.png new file mode 100644 index 0000000000000000000000000000000000000000..bd5dc8ffc0d98e48ba0077bc14273a7e9c7de53f GIT binary patch literal 9119 zcmZ{K2|QHM`}ess%*Zl|60($aQk0#sU8O{pDbk9HY=yFx^+pSorBb5grjn&d4I)cL z*^-GNjiR!RJ^M14_l|!5_y4~C&->12?q}|t^W1Zu^DN)zIp?{tR2y?4eo1}+fRM!= zv;6?zPynD`e0Z$IdjB>8_A^MevfqXM0zd)44Nww+TM@|SfC_g|S*@w5iM3Jyg#z3t z6zrQwN$jxZetfL0bImRvvT1D6mgrqFWIM>+`Yp@v)Bg@yYec?Fq{R@hjBv z*75PRoJ0yp>(j&G3=IuUOiauLd2>#D#-7ATIUR}I=P;6P4-~UM=sQAUtPd>V@cE2rfSL}GP^*)C)wiOal08txb1Y&nabWQGg@cZl+sQTbL zD5k+;m8ry#>i`d&XbslZANilx1t`S+NqJm8gOmtGvT>_`WxMgbAfUd@>T;ft0BF#@ z%E}&10FPuuMAo?jgt=>J`BoDEh1VCB6w@K#wSJnt*BB2NYJ;=MVT8N*siowmkTK5q z?ALsKWs~@oVQPug$?S&@Zp)f8#T%Jj>f51*I>>fs{qhKnvCDLXa9yg+(-_5tb1p?&jZQ9 zUuX3c3Mx0j+r~PK18pLtUI@{vHfcN>x^8MdwJdX5U#LNU{u~ed?0Z7qFp$3OKhf>6 z1qpExfVH`@Y$LEh>@x2b(Ax80QSXQ}>IP9QIPPnKV>1MJ(T4WmKty~kqINRfAm-<6 zc8Bd|;Pp)s#B~-v`EIL%sR~FJr`uzy0u&#UY>?%68mv_(gT}Uq#OMt2EoSgO8>Fr3 z-f(mZV1<#ceYi;f6!B_D$UZnfFE0eCFe<^rlV`U>^neqiw-6^si%U94#p19n*;Ky% z>0M));J0b>Z-G5=?SU|Ref3XsQgQ)PZ^2rGKo+E~_f{kDqUzck(7HXv zUMJ{t3^n!cY2&9((l0|V9yB0rp$!qsp}efCk)b*-^=BVMK9rE!h<8vGAkV5n^;cC6 zdN|Y+pV^k5oGBOZ#iU6P^Ru^Nai)Q=iSY~FIgd|_*ZVQvR7Rq|1Q!1Zgy;Ke&IFs0 zFoXZJbZf<9AnPC2l|Jyac+&Ne%?-H==6y?L+zt?6mP@cd{c-Z$>uZKX4vX)uqW_{G%6p#QdAPr)X5T_(WRA7khE0SxB6*DX!iC--nrTh@BZ{{) z+Fi#_UC%Wz;8B6eS&+292E_#C=A9l!z^vrIeYT4cH>Zu0RKmtva}K^89G$m@nuJb% zCt`x7M=*5^F)KV_`9t6uW`$QaYoiR8wSXcAQuD(BB|5qqvo&7yLWeRJHV&R7LhMRC zeq=X~eQJ>5n~tlP_OtxYhKEc445=j@iT^Nh9YVx*ZNjTq8_0A{w_{pmP~KG7z$_`` z) zM|~Q&eXseF*9e~8LvkZ(MO>Fb@?_|fPt=kG6; z4=luAJX{g-!6`Ci`AOJPTo6DTFd6se5-S}PSj?Ex!f}>)#qQeJiENy1`xi5&77G z*4vLnFwAhpbS;O!Ca$H)7T?ze>b)jyBg^Ne7Hdl9)nuihrMaY$!SQA1NMASE`@x1m zm`J`788cH^a-RH-JoBlVEJfOIl{AEL!4rx)hO;y}vHK+g0)eCt5^CHZu zZ172~<7KJ&?y||Bq*wHQ7)au7wZ7l|Pqj1^W6rFwb!=Ux{e zTgKcL=A0vQKTy@#?Pc8sn90R#L@1%aO>H9b51wgTgKrEB37J}QwP!iWb*6=X45k^3o7!^oK72fvot>!=?874LHo4TOy`LO4NUlkWaL90#&dWkKP={Q-j(5c;@|}Gd~8ZFh8Ni zW0G2cj{FoX;c3m3{*S&so;@29lFFz!AnHP|+n6swbxN~9yjtQL4P*>3-OKTB0kSXme zK)*RuroQ)c|0fWb$c6s9m67%8*5X@naP;sqnX^PJI>g)(KFq~%Gr;IF25IjhqSol& z)dxU;8yBuHn0669zF+!@W;reVB9A5g$;{&f&?^089cWxn$8s_1WZ?WNxEvGE+vuU8 z<2#147B;lt`N%&id!3PS+(ox!~0h+WrKjX$ftrXh@v;a zhoqX|P=CQg1hitNpFm3qTHMC*`8mafB(16>;gTz|dEMdVcshV{kIE;bjWic_=8Dm$ zC^fcPst4KW?a@{XXhbFqlp&Q&>7%+vT>ok0_u$ti-HLnOC4!!07BpnmB-!`+4Jaf@ z(VvRm-1GXsNS8U+BBZLWkdmggae03~|7e zIDzb5FX=i6lZso`L`z}>ka`w*S_w-1RU!-=jnL8k`=%hR3e2L`H6J?j=hIDb+F$FG z$H2o7?uwk=(D8k)r>CN~gBu?zqJQ`A2{|z!qU$y-yZduQ2%O8ZA=*pMrzoR$mB;ha zMjhA%yzmm#JL2*InX#-L2%8zH$(!Q(ta^GUlOhN#_T`!C?dMFg#%rFn?f4==-MQuA zYScW|mTi1YY`X8cJRz{i7dKV)xaJJyZ-;?~xo($pQtybZyKtAFlmmYj)gE>cK<s(&^a6U_IK4ZTW>@GIuDPDd}bnwK|yY-3rJ>!mh zJZSf0p@q>+?qAQ-)szoJl?oMYP}?!09bO)_cqI7u9`8sIR9=y_8!Bu}cEMpWB@T%Q z3#nv;ruY=eM3W$|GL4oBQJX7{ouhW7ekLkEP}h=;X?Mii;}6N{d%1eIVOWQ^5UQ)P8wQwBIqf- z7(n?!TCRsgDT7NR0t&m?rYjHdA$_NvH(o4E5p4E44@waXwSn|uy3fJ!fwwmWPg1cR zXsj63cz@5O(=KsOZeAUMHb|dpw%y%a0n0h8qWDj^Q0^H@R+oGsqRTVZNSlEOp1x*0 zi;;bdccnpR2|bDr82lu|P8%ZmVbD>rimq{-()_tDp$FaVFNYdniDo$i(1UWMSOkEIMAlA`U5GvegFOQFfnugrRFZhWw~hg5cw zdQkcbUz{$<_cTHf6id;cUyEVWYPJ%*^GXLsa#_l1%V~%kxCeh9_o5vkX(f3X%Tr6$ z;fCTf#9;gJXfG)6jMAOUrwr|G_yxEi*CMFtdGwUqCaYR)2As9oEobM*(m@9ePt06g;kS6iS9cy^t``wr#p zt%#VqmC!20XElBK2B~Su5DUQJAVez0G<2eKP0Hlqxv&;2_VywaM{OR~T=x@==|L+j zoXP~_5sKiEFYfBfC{tSLKPhhLUE zXqvTEfAj+^0@PZhEpx?66$|&r*dUI?;B{F8<=~bMX~rh0H^zI5`Yil zvkKTh*U%jntbVU?vP~<&qe}_EqxZNh53BuiP{;H02LO$;2AqnMH$X#%^@ZpediI1L zZ*~eY*&Z&4qzgUO7V^m7%VeJz%ADqk<9i%4P{gS;T>PkY`{#bD8SY-O_xa zTJ2V)0E{JRbQj%2m&$#1|CnV?Qry})t)EUA**lw=WMP}ikR)@>LjSuM%+2`ZAQ_L1 z-x&j=QYeS^QQ}-t$k90Gulr;%MQc1Ly_z=i-1caK(KgW+H=jyYX2^2$Nh2MjDQ&x5 zAKg!sS;+-SQ4g$Snd>z5heQHi)~SA*2LZ-xV9y({on{}^Tp(^Qieb7i+)?t^??-zA zybd8 ze}X{vJMs!{$UHr;KJ>HD2|l!-2R})uCA8VX?Ij(O{$Bgm%19U6Lrc&zqw*nXsqZHU zj1hf<75OG;r#3Qmt9B+>X_q|)S(TWc8Bw;H=$EBAr90UN-{8?)oP9_88;B;28oujK z`noCguR>kdG65R#E_aL}jvHhvIb7c_K_B?JdqoDPNY#gKlBi$Y&9j8)<3S=Tv+UZE z%}djpI3>a8+h5aTif5eIO~g7XO<}gWM@#&AL@X?65u7jIECaN%msD{%76H*>-U%$z z!B^i}yVoE}g~G5RJb&c1D%zLJHk2b+dqzs4`AuKAnSgI3C3G&6L2`wRikfc5H>Muf zfy4VeaG0sIfbi){OUqM>7V`@mMqqKOdjA`xsrIQGsd`hxKHRvb3@r?7+t&VjCi(hA zA6sA=CeS6;MToCx9}=?dRk*Ww+*-6Q*BKYMRmK%k3VI-y((ofO+ThF$@vyA&`o)| zS$4w9%5T+?$qQ6l8;RwMB8;wO1-Qh?NJ7Q54r0O%qB#%tGk1U_arB7`6_0w)mibv8 z+l0B=uQkzMPGafCa~;mqx9he|kk%2|qz0<`=%IfXrsgG2B>r??PiR)<)dF!v4Z*C94F4b{u1fS_cJxU5 z=&H9nq$?EGFdsnJQD>JFdf;3(RKI2EN|Vm#Vcq7?s(YUphw+&FiV5Vg1X%*j$a8R4 z>gQ)KiC7ZoD?*)K+okH1@_W+}>z~?Q`B}G>f#gRF1A?s2m&87q+-w{$>U#?+FD>P_ zDs}`(I_Qj155>4pCrnuuewr~esG|M|Bx#|8^%i|1S`eDXHOxU|FnqVtW<>Jtf|{W9 z`PL|%09VFiCCt~-_0T0J>u5nF=h8LeuIL_Vm3KHxYBiTTkR=n%54U=C5FXm|gg}(> zg*qHcgAP>CamHa12@d|EpF@cq>G5Xpe+;T)nIz()&O7bKfu(#l*Y6;D;N-fmx>{Yr#&lnY% z1p1X1GiA=6F%D&wOWKf1AVnz1MB>WV!=OATLR|)8ot)8K#d?2s5Velm(o^RT0@T?@ z@l*8N-*1mpc18F$bfDOg1fkt|9qQflJ^kAzSF&k>$m^v(yBnVjxhj@{XW5gJ{>$~- zrJl4>1?!!}LrmDcFR(35=5<6^6eI1^I_z`-=1Db};8(+NrZG0(zE&lY^wz0#~ z>0b6y*h+0BsU>Jn_}oe(+;QO|LN?H0mB@@_T&6F&ouxVc97$6|fd( zEbuCOdtZ0ztpiH9_s}kuhZik0{S!F0`7$jkdAZ@_5#L zR7%)Yqx+2q)$dS-Sku#ildnRw|4O~i$RFi-@z|R$c5dQRb%m&dGZrAHygzKT@Z-)K$mnyV=zzgWS&9aY)Z0Gdr!TEW zo2#DSyOs-!6Jw~~^j3;l$9Kcs*K5+s{e{q<*>>4LRp3-fY4rD(z4By(-lI`L)=zAn zeVYa$^J}}LA30|4?(=`Q-IB^b6AN_pi z6pekHjyy6QTnr!^9at%!!D94MKND}p&{EQ@o)#D!zOu5A97N}Lzo&VYNbti!1Y5Q8 z+#_z04bekS31l$~p8)3F`z`Ydk=!;N^o9jQK3!IPw0_+4?;mCnYj|6^mdZ-eEejWN zX6||G^P|NkMXKjZ^zMMbjSoq4n3gT_3tOR!Xq zJ&!+fCr#>0`R8Yr9!KBW^4P_!tcZz>+Pr1{1RndEqGmHE_i(ti!c8#yw!W*@tOm-< zc_Xv%{khf9z&}k=5Xrs`o4w^X6I7F?#jD#D@>iW*sWwpY_M4JKH%FLd9i|;C+V(kg zqy7rV&;n8<`YQyH2@T`2)+9*XDcyBokb*J~LM+LVeuBqOt6LJ@f7fbi8BhY(mj6e1 ze5hcy>Gb?2#hc!kdH?6JKdDW3=`LUM{6+t%+K)F$yX~o*{U85>TKJuMaT(t$?2e9p zWsa}#=gRNF`=@Y!T`{5~oRE_)e_By{mojjyfA0XjNVXJ190J2Ofjg-qVHs|5Su-#B zkT1Q*A0s*m@p<{P)2VgrjP`G7Q~N8MAK_{48y#$oRxCmvUq3jXV;T_dXyWBgseN0^ z2k+z%bXE*IQ6J5ytLV1XoNd-P-gqyuI_wr#s)@2_S;M3~EtXj)_0ukB+|d7u;|&(K zpj=C$zG$r&Ydf_XD;~xx{#Siih)%Fx4vkb1d*FM2ljYH3)|t1*$}v>`Q#ORfkXM~EA?Fk!*2Bq?p}C%&F#ECL zxya<8m%Q-(-aBjI`7z0_(Pf*HL$Q*38b$bS2z%-xml zZu0e|jAXI>2tj6yRHa5H2onb#$oXlh6-Q_ZJ@wd<;EP? zfBjtd>^GMsVc7jFA~@GUL^bueeRw*zn91GLaqE_m>;gz}^MtTRw)?wHOCaf0*8k&$ z0RDaJ!R1$C|HsvK7aF;8^fsfh*xlXsu8kSenU)rA6oJspsZ7%CIUE6)>`0w+hJ z$2r@8<-uZ;n|-eXav(rH{4;E?0XQX@@CYIw*w=68nBqnSNjXmG>T9mh>ahY~Oer8I z75;xOR@6dGSF(-iG7fDRz+PpzYqNuUy9%N3A(^c;&yK4YSTm<2_$| zr#H;7mzxI~oUo08v2pp)i1SnTI7!KZjn~>{ge>XjAo>##!R5)>g+_L0!c$!ka10~t z?3}kQ%ki3S;<;VFp;if`+T-ZL3C5vqVyW1FHSB-Xd+b$&)`gBtx_u`cgbi{sPGM&9 z?wu5DH{ZCS^H9_<4)s(lO>uHC?N66A$`fepvkokK8?f-|e=6YrQU(X#12?q}|t^W1Zu^DN)zIp?{tR2y?4eo1}+fRM!= zv;6?zPynD`e0Z$IdjB>8_A^MevfqXM0zd)44Nww+TM@|SfC_g|S*@w5iM3Jyg#z3t z6zrQwN$jxZetfL0bImRvvT1D6mgrqFWIM>+`Yp@v)Bg@yYec?Fq{R@hjBv z*75PRoJ0yp>(j&G3=IuUOiauLd2>#D#-7ATIUR}I=P;6P4-~UM=sQAUtPd>V@cE2rfSL}GP^*)C)wiOal08txb1Y&nabWQGg@cZl+sQTbL zD5k+;m8ry#>i`d&XbslZANilx1t`S+NqJm8gOmtGvT>_`WxMgbAfUd@>T;ft0BF#@ z%E}&10FPuuMAo?jgt=>J`BoDEh1VCB6w@K#wSJnt*BB2NYJ;=MVT8N*siowmkTK5q z?ALsKWs~@oVQPug$?S&@Zp)f8#T%Jj>f51*I>>fs{qhKnvCDLXa9yg+(-_5tb1p?&jZQ9 zUuX3c3Mx0j+r~PK18pLtUI@{vHfcN>x^8MdwJdX5U#LNU{u~ed?0Z7qFp$3OKhf>6 z1qpExfVH`@Y$LEh>@x2b(Ax80QSXQ}>IP9QIPPnKV>1MJ(T4WmKty~kqINRfAm-<6 zc8Bd|;Pp)s#B~-v`EIL%sR~FJr`uzy0u&#UY>?%68mv_(gT}Uq#OMt2EoSgO8>Fr3 z-f(mZV1<#ceYi;f6!B_D$UZnfFE0eCFe<^rlV`U>^neqiw-6^si%U94#p19n*;Ky% z>0M));J0b>Z-G5=?SU|Ref3XsQgQ)PZ^2rGKo+E~_f{kDqUzck(7HXv zUMJ{t3^n!cY2&9((l0|V9yB0rp$!qsp}efCk)b*-^=BVMK9rE!h<8vGAkV5n^;cC6 zdN|Y+pV^k5oGBOZ#iU6P^Ru^Nai)Q=iSY~FIgd|_*ZVQvR7Rq|1Q!1Zgy;Ke&IFs0 zFoXZJbZf<9AnPC2l|Jyac+&Ne%?-H==6y?L+zt?6mP@cd{c-Z$>uZKX4vX)uqW_{G%6p#QdAPr)X5T_(WRA7khE0SxB6*DX!iC--nrTh@BZ{{) z+Fi#_UC%Wz;8B6eS&+292E_#C=A9l!z^vrIeYT4cH>Zu0RKmtva}K^89G$m@nuJb% zCt`x7M=*5^F)KV_`9t6uW`$QaYoiR8wSXcAQuD(BB|5qqvo&7yLWeRJHV&R7LhMRC zeq=X~eQJ>5n~tlP_OtxYhKEc445=j@iT^Nh9YVx*ZNjTq8_0A{w_{pmP~KG7z$_`` z) zM|~Q&eXseF*9e~8LvkZ(MO>Fb@?_|fPt=kG6; z4=luAJX{g-!6`Ci`AOJPTo6DTFd6se5-S}PSj?Ex!f}>)#qQeJiENy1`xi5&77G z*4vLnFwAhpbS;O!Ca$H)7T?ze>b)jyBg^Ne7Hdl9)nuihrMaY$!SQA1NMASE`@x1m zm`J`788cH^a-RH-JoBlVEJfOIl{AEL!4rx)hO;y}vHK+g0)eCt5^CHZu zZ172~<7KJ&?y||Bq*wHQ7)au7wZ7l|Pqj1^W6rFwb!=Ux{e zTgKcL=A0vQKTy@#?Pc8sn90R#L@1%aO>H9b51wgTgKrEB37J}QwP!iWb*6=X45k^3o7!^oK72fvot>!=?874LHo4TOy`LO4NUlkWaL90#&dWkKP={Q-j(5c;@|}Gd~8ZFh8Ni zW0G2cj{FoX;c3m3{*S&so;@29lFFz!AnHP|+n6swbxN~9yjtQL4P*>3-OKTB0kSXme zK)*RuroQ)c|0fWb$c6s9m67%8*5X@naP;sqnX^PJI>g)(KFq~%Gr;IF25IjhqSol& z)dxU;8yBuHn0669zF+!@W;reVB9A5g$;{&f&?^089cWxn$8s_1WZ?WNxEvGE+vuU8 z<2#147B;lt`N%&id!3PS+(ox!~0h+WrKjX$ftrXh@v;a zhoqX|P=CQg1hitNpFm3qTHMC*`8mafB(16>;gTz|dEMdVcshV{kIE;bjWic_=8Dm$ zC^fcPst4KW?a@{XXhbFqlp&Q&>7%+vT>ok0_u$ti-HLnOC4!!07BpnmB-!`+4Jaf@ z(VvRm-1GXsNS8U+BBZLWkdmggae03~|7e zIDzb5FX=i6lZso`L`z}>ka`w*S_w-1RU!-=jnL8k`=%hR3e2L`H6J?j=hIDb+F$FG z$H2o7?uwk=(D8k)r>CN~gBu?zqJQ`A2{|z!qU$y-yZduQ2%O8ZA=*pMrzoR$mB;ha zMjhA%yzmm#JL2*InX#-L2%8zH$(!Q(ta^GUlOhN#_T`!C?dMFg#%rFn?f4==-MQuA zYScW|mTi1YY`X8cJRz{i7dKV)xaJJyZ-;?~xo($pQtybZyKtAFlmmYj)gE>cK<s(&^a6U_IK4ZTW>@GIuDPDd}bnwK|yY-3rJ>!mh zJZSf0p@q>+?qAQ-)szoJl?oMYP}?!09bO)_cqI7u9`8sIR9=y_8!Bu}cEMpWB@T%Q z3#nv;ruY=eM3W$|GL4oBQJX7{ouhW7ekLkEP}h=;X?Mii;}6N{d%1eIVOWQ^5UQ)P8wQwBIqf- z7(n?!TCRsgDT7NR0t&m?rYjHdA$_NvH(o4E5p4E44@waXwSn|uy3fJ!fwwmWPg1cR zXsj63cz@5O(=KsOZeAUMHb|dpw%y%a0n0h8qWDj^Q0^H@R+oGsqRTVZNSlEOp1x*0 zi;;bdccnpR2|bDr82lu|P8%ZmVbD>rimq{-()_tDp$FaVFNYdniDo$i(1UWMSOkEIMAlA`U5GvegFOQFfnugrRFZhWw~hg5cw zdQkcbUz{$<_cTHf6id;cUyEVWYPJ%*^GXLsa#_l1%V~%kxCeh9_o5vkX(f3X%Tr6$ z;fCTf#9;gJXfG)6jMAOUrwr|G_yxEi*CMFtdGwUqCaYR)2As9oEobM*(m@9ePt06g;kS6iS9cy^t``wr#p zt%#VqmC!20XElBK2B~Su5DUQJAVez0G<2eKP0Hlqxv&;2_VywaM{OR~T=x@==|L+j zoXP~_5sKiEFYfBfC{tSLKPhhLUE zXqvTEfAj+^0@PZhEpx?66$|&r*dUI?;B{F8<=~bMX~rh0H^zI5`Yil zvkKTh*U%jntbVU?vP~<&qe}_EqxZNh53BuiP{;H02LO$;2AqnMH$X#%^@ZpediI1L zZ*~eY*&Z&4qzgUO7V^m7%VeJz%ADqk<9i%4P{gS;T>PkY`{#bD8SY-O_xa zTJ2V)0E{JRbQj%2m&$#1|CnV?Qry})t)EUA**lw=WMP}ikR)@>LjSuM%+2`ZAQ_L1 z-x&j=QYeS^QQ}-t$k90Gulr;%MQc1Ly_z=i-1caK(KgW+H=jyYX2^2$Nh2MjDQ&x5 zAKg!sS;+-SQ4g$Snd>z5heQHi)~SA*2LZ-xV9y({on{}^Tp(^Qieb7i+)?t^??-zA zybd8 ze}X{vJMs!{$UHr;KJ>HD2|l!-2R})uCA8VX?Ij(O{$Bgm%19U6Lrc&zqw*nXsqZHU zj1hf<75OG;r#3Qmt9B+>X_q|)S(TWc8Bw;H=$EBAr90UN-{8?)oP9_88;B;28oujK z`noCguR>kdG65R#E_aL}jvHhvIb7c_K_B?JdqoDPNY#gKlBi$Y&9j8)<3S=Tv+UZE z%}djpI3>a8+h5aTif5eIO~g7XO<}gWM@#&AL@X?65u7jIECaN%msD{%76H*>-U%$z z!B^i}yVoE}g~G5RJb&c1D%zLJHk2b+dqzs4`AuKAnSgI3C3G&6L2`wRikfc5H>Muf zfy4VeaG0sIfbi){OUqM>7V`@mMqqKOdjA`xsrIQGsd`hxKHRvb3@r?7+t&VjCi(hA zA6sA=CeS6;MToCx9}=?dRk*Ww+*-6Q*BKYMRmK%k3VI-y((ofO+ThF$@vyA&`o)| zS$4w9%5T+?$qQ6l8;RwMB8;wO1-Qh?NJ7Q54r0O%qB#%tGk1U_arB7`6_0w)mibv8 z+l0B=uQkzMPGafCa~;mqx9he|kk%2|qz0<`=%IfXrsgG2B>r??PiR)<)dF!v4Z*C94F4b{u1fS_cJxU5 z=&H9nq$?EGFdsnJQD>JFdf;3(RKI2EN|Vm#Vcq7?s(YUphw+&FiV5Vg1X%*j$a8R4 z>gQ)KiC7ZoD?*)K+okH1@_W+}>z~?Q`B}G>f#gRF1A?s2m&87q+-w{$>U#?+FD>P_ zDs}`(I_Qj155>4pCrnuuewr~esG|M|Bx#|8^%i|1S`eDXHOxU|FnqVtW<>Jtf|{W9 z`PL|%09VFiCCt~-_0T0J>u5nF=h8LeuIL_Vm3KHxYBiTTkR=n%54U=C5FXm|gg}(> zg*qHcgAP>CamHa12@d|EpF@cq>G5Xpe+;T)nIz()&O7bKfu(#l*Y6;D;N-fmx>{Yr#&lnY% z1p1X1GiA=6F%D&wOWKf1AVnz1MB>WV!=OATLR|)8ot)8K#d?2s5Velm(o^RT0@T?@ z@l*8N-*1mpc18F$bfDOg1fkt|9qQflJ^kAzSF&k>$m^v(yBnVjxhj@{XW5gJ{>$~- zrJl4>1?!!}LrmDcFR(35=5<6^6eI1^I_z`-=1Db};8(+NrZG0(zE&lY^wz0#~ z>0b6y*h+0BsU>Jn_}oe(+;QO|LN?H0mB@@_T&6F&ouxVc97$6|fd( zEbuCOdtZ0ztpiH9_s}kuhZik0{S!F0`7$jkdAZ@_5#L zR7%)Yqx+2q)$dS-Sku#ildnRw|4O~i$RFi-@z|R$c5dQRb%m&dGZrAHygzKT@Z-)K$mnyV=zzgWS&9aY)Z0Gdr!TEW zo2#DSyOs-!6Jw~~^j3;l$9Kcs*K5+s{e{q<*>>4LRp3-fY4rD(z4By(-lI`L)=zAn zeVYa$^J}}LA30|4?(=`Q-IB^b6AN_pi z6pekHjyy6QTnr!^9at%!!D94MKND}p&{EQ@o)#D!zOu5A97N}Lzo&VYNbti!1Y5Q8 z+#_z04bekS31l$~p8)3F`z`Ydk=!;N^o9jQK3!IPw0_+4?;mCnYj|6^mdZ-eEejWN zX6||G^P|NkMXKjZ^zMMbjSoq4n3gT_3tOR!Xq zJ&!+fCr#>0`R8Yr9!KBW^4P_!tcZz>+Pr1{1RndEqGmHE_i(ti!c8#yw!W*@tOm-< zc_Xv%{khf9z&}k=5Xrs`o4w^X6I7F?#jD#D@>iW*sWwpY_M4JKH%FLd9i|;C+V(kg zqy7rV&;n8<`YQyH2@T`2)+9*XDcyBokb*J~LM+LVeuBqOt6LJ@f7fbi8BhY(mj6e1 ze5hcy>Gb?2#hc!kdH?6JKdDW3=`LUM{6+t%+K)F$yX~o*{U85>TKJuMaT(t$?2e9p zWsa}#=gRNF`=@Y!T`{5~oRE_)e_By{mojjyfA0XjNVXJ190J2Ofjg-qVHs|5Su-#B zkT1Q*A0s*m@p<{P)2VgrjP`G7Q~N8MAK_{48y#$oRxCmvUq3jXV;T_dXyWBgseN0^ z2k+z%bXE*IQ6J5ytLV1XoNd-P-gqyuI_wr#s)@2_S;M3~EtXj)_0ukB+|d7u;|&(K zpj=C$zG$r&Ydf_XD;~xx{#Siih)%Fx4vkb1d*FM2ljYH3)|t1*$}v>`Q#ORfkXM~EA?Fk!*2Bq?p}C%&F#ECL zxya<8m%Q-(-aBjI`7z0_(Pf*HL$Q*38b$bS2z%-xml zZu0e|jAXI>2tj6yRHa5H2onb#$oXlh6-Q_ZJ@wd<;EP? zfBjtd>^GMsVc7jFA~@GUL^bueeRw*zn91GLaqE_m>;gz}^MtTRw)?wHOCaf0*8k&$ z0RDaJ!R1$C|HsvK7aF;8^fsfh*xlXsu8kSenU)rA6oJspsZ7%CIUE6)>`0w+hJ z$2r@8<-uZ;n|-eXav(rH{4;E?0XQX@@CYIw*w=68nBqnSNjXmG>T9mh>ahY~Oer8I z75;xOR@6dGSF(-iG7fDRz+PpzYqNuUy9%N3A(^c;&yK4YSTm<2_$| zr#H;7mzxI~oUo08v2pp)i1SnTI7!KZjn~>{ge>XjAo>##!R5)>g+_L0!c$!ka10~t z?3}kQ%ki3S;<;VFp;if`+T-ZL3C5vqVyW1FHSB-Xd+b$&)`gBtx_u`cgbi{sPGM&9 z?wu5DH{ZCS^H9_<4)s(lO>uHC?N66A$`fepvkokK8?f-|e=6YrQU(X#`: From 99fa4083d4dc8b2bdc70b78f5529743ca3baca7f Mon Sep 17 00:00:00 2001 From: stefanedwards Date: Fri, 28 Apr 2017 15:01:30 +0100 Subject: [PATCH 6/7] Passes R CHECK! --- .Rbuildignore | 4 +++- DESCRIPTION | 28 +++++++++++----------- NAMESPACE | 7 ------ R/brackets.R | 20 +++++++++------- R/coord-capped.r | 1 + R/coord-flex.r | 11 +++++---- R/facet-wrap.r | 5 +--- R/knit_print.r | 4 ++-- R/legends.r | 6 ++++- README.Rmd | 3 ++- README.md | 1 + man/brackets.Rd | 2 +- man/coord_capped.Rd | 6 ++--- man/coord_flex.Rd | 9 +++---- man/facet_rep.Rd | 13 ++++------- man/g_legend.Rd | 2 ++ man/grid_arrange_shared_legend.Rd | 1 + man/reposition_legend.Rd | 3 ++- man/splot.Rd | 39 ++++++++++++++++++++++++++----- vignettes/legends.Rmd | 20 ++++++++++++++-- 20 files changed, 115 insertions(+), 70 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index cd5f26a..5b94133 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -2,6 +2,8 @@ ^.*\.Rproj$ ^\.Rproj\.user$ ^/lib/$ +^lib\$ .Rprofile ^README\.Rmd$ -^README\*.png$ \ No newline at end of file +^README\*.png$ +^lib$ diff --git a/DESCRIPTION b/DESCRIPTION index 5ce4494..d9a870d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,27 +1,27 @@ Package: splot Type: Package Title: splot! - Stefan's plot library of tricks +URL: https://github.com/stefanedwards/splot +BugReports: https://github.com/stefanedwards/splot/issues Version: 0.2.0 -Author: Stefan McKinnon Edwards +Author@R: person(c('Stefan','McKinnon'), 'Edwards', email='sme@iysik.com', role=c('aut','ctb','cre')) +Author: Stefan McKinnon Edwards [aut, ctb, cre] Maintainer: Stefan McKinnon Edwards Description: Yet another ggplot2 and knitr extension package. + Includes functions for manipulating ggplot2 legends, + axis lines, and a bit of knitr magic. +Depends: R (>= 3.1.0) Imports: - ggplot2, + ggplot2 (>= 2.2.0), grid, gridExtra, gtable, - RCurl -Depends: - ggplot2, - grid, - gridExtra, - gtable, -Enhances: ggplot2, - knitr -License: GPL-3 + RCurl, + knitr (>= 1.12) +License: GPL-3 + file LICENSE Encoding: UTF-8 LazyData: true -RoxygenNote: 5.0.1 +RoxygenNote: 6.0.1 Collate: 'ggplot2.r' 'brackets.R' @@ -33,6 +33,6 @@ Collate: 'legends.r' 'splot.r' Suggests: - knitr, - rmarkdown + rmarkdown, + stringr VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 1038dbb..5aa78df 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,12 +28,5 @@ import(grid) import(gridExtra) import(gtable) import(knitr) -importFrom(ggplot2,CoordCartesian) -importFrom(ggplot2,CoordFixed) -importFrom(ggplot2,CoordFlip) importFrom(ggplot2,ggproto) importFrom(grid,unit) -importFrom(gtable,gtable_col) -importFrom(gtable,gtable_height) -importFrom(gtable,gtable_row) -importFrom(gtable,gtable_width) diff --git a/R/brackets.R b/R/brackets.R index 1dea1ad..284668e 100644 --- a/R/brackets.R +++ b/R/brackets.R @@ -25,6 +25,7 @@ NULL #' If \code{waiver()} (default), use \code{axis.ticks.length} from \code{\link{theme}}. #' #' @examples +#' library(ggplot2) #' p <- ggplot(mpg, aes(as.factor(cyl), hwy, colour=class)) + #' geom_point(position=position_jitter(width=0.3)) + #' theme_bw() + @@ -39,7 +40,8 @@ NULL #' # A further adjustment, #' p + theme(panel.grid.major.x = element_blank()) #' @import grid -#' @importFrom gtable gtable_col gtable_row gtable_width gtable_height +#' @import ggplot2 +#' @import gtable brackets_horisontal <- function(direction = c('up','down'), length = unit(0.05, 'native'), tick.length = waiver()) { @@ -71,12 +73,12 @@ brackets_horisontal <- function(direction = c('up','down'), labels <- agrob$children[[ind.notline]]$grobs[[ind.text]] gt <- switch(position, - top = gtable_col('axis', + top = gtable::gtable_col('axis', grobs = list(labels, brackets), width = unit(1, 'npc'), heights = unit.c(grobHeight(labels), tick.length) ), - bottom = gtable_col('axis', + bottom = gtable::gtable_col('axis', grobs = list(brackets, labels), width = unit(1, 'npc'), heights = unit.c(tick.length, grobHeight(labels)) @@ -89,8 +91,8 @@ brackets_horisontal <- function(direction = c('up','down'), ggplot2:::absoluteGrob( gList(gt), - width = gtable_width(gt), - height = gtable_height(gt), + width = gtable::gtable_width(gt), + height = gtable::gtable_height(gt), vp = justvp ) } @@ -132,12 +134,12 @@ brackets_vertical <- function(direction = c('left','right'), labels <- agrob$children[[ind.notline]]$grobs[[ind.text]] gt <- switch(position, - left = gtable_row('axis', + left = gtable::gtable_row('axis', grobs = list(labels, brackets), height = unit(1, 'npc'), widths = unit.c(grobWidth(labels), tick.length) ), - right = gtable_row('axis', + right = gtable::gtable_row('axis', grobs = list(brackets, labels), height = unit(1, 'npc'), widths = unit.c(tick.length, grobWidth(labels)) @@ -150,8 +152,8 @@ brackets_vertical <- function(direction = c('left','right'), ggplot2:::absoluteGrob( gList(gt), - width = gtable_width(gt), - height = gtable_height(gt), + width = gtable::gtable_width(gt), + height = gtable::gtable_height(gt), vp = justvp ) } diff --git a/R/coord-capped.r b/R/coord-capped.r index 60ec279..6eb4f38 100644 --- a/R/coord-capped.r +++ b/R/coord-capped.r @@ -33,6 +33,7 @@ NULL #' @rdname coord_capped #' @export #' @examples +#' library(ggplot2) #' # Notice how the axis lines of the following plot meet in the lower-left corner. #' p <- ggplot(mtcars, aes(x = mpg)) + geom_dotplot() + #' theme_bw() + diff --git a/R/coord-flex.r b/R/coord-flex.r index 243baa9..f4d5bd7 100644 --- a/R/coord-flex.r +++ b/R/coord-flex.r @@ -40,7 +40,7 @@ NULL #' limits are taken exactly from the data or \code{xlim}/\code{ylim}. #' @export #' @examples -#' +#' library(ggplot2) #' # A standard plot #' p <- ggplot(mtcars, aes(disp, wt)) + #' geom_point() + @@ -66,7 +66,8 @@ NULL #' #' # Also works with secondary axes: #' p + scale_y_continuous(sec.axis=sec_axis(~5*., name='wt times 5')) + -#' coord_flex_cart(left=brackets_vertical(), bottom=capped_horisontal('right'), right=capped_vertical('both', gap=0.02)) +#' coord_flex_cart(left=brackets_vertical(), bottom=capped_horisontal('right'), +#' right=capped_vertical('both', gap=0.02)) #' #' #' # Supports the usual 'coord_fixed': @@ -169,7 +170,7 @@ flex_render_axis_v <- function(self, scale_details, theme) { #' @format NULL #' @usage NULL #' @export -#' @importFrom ggplot2 CoordCartesian ggproto +#' @import ggplot2 CoordFlexCartesian <- ggplot2::ggproto('CoordFlexCartesian', `_inherit` = ggplot2::CoordCartesian, render_axis_h = flex_render_axis_h, @@ -180,7 +181,7 @@ CoordFlexCartesian <- ggplot2::ggproto('CoordFlexCartesian', #' @format NULL #' @usage NULL #' @export -#' @importFrom ggplot2 CoordFlip ggproto +#' @import ggplot2 CoordFlexFlipped <- ggplot2::ggproto('CoordFlexFlipped', `_inherit` = ggplot2::CoordFlip, render_axis_h = flex_render_axis_h, render_axis_v = flex_render_axis_v @@ -190,7 +191,7 @@ CoordFlexFlipped <- ggplot2::ggproto('CoordFlexFlipped', `_inherit` = ggplot2:: #' @format NULL #' @usage NULL #' @export -#' @importFrom ggplot2 CoordFixed ggproto +#' @import ggplot2 CoordFlexFixed <- ggplot2::ggproto('CoordFlexFlipped', `_inherit` = ggplot2::CoordFixed, render_axis_h = flex_render_axis_h, render_axis_v = flex_render_axis_v diff --git a/R/facet-wrap.r b/R/facet-wrap.r index fce8393..0cdecf9 100644 --- a/R/facet-wrap.r +++ b/R/facet-wrap.r @@ -2,12 +2,9 @@ NULL #' @rdname facet_rep +#' @inheritParams facet_rep_grid #' @import ggplot2 #' @export -#' @examples -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point() + -#' facet_wrap(~class) facet_rep_wrap <- function(..., repeat.tick.labels=FALSE) { f <- facet_wrap(...) params <- append(f$params, list(repeat.tick.labels=repeat.tick.labels)) diff --git a/R/knit_print.r b/R/knit_print.r index 0ad7139..ce6d8ff 100644 --- a/R/knit_print.r +++ b/R/knit_print.r @@ -31,11 +31,11 @@ #' @import knitr knit_print.data.frame = function(x, options, ...) { if (getOption('knit_print', default=TRUE) == FALSE) - return(normal_print(x, options, ...)) + return(knitr::normal_print(x, options, ...)) opts <- options$`kable.opts` if (is.null(opts)) opts <- NULL opts <- RCurl::merge.list(list(x=x, digits=2), opts) - res = paste(c("","", do.call(kable, opts)), collapse="\n") + res = paste(c("","", do.call(knitr::kable, opts)), collapse="\n") asis_output(res) } diff --git a/R/legends.r b/R/legends.r index eeb3838..3405b5e 100644 --- a/R/legends.r +++ b/R/legends.r @@ -16,6 +16,8 @@ NULL #' @import ggplot2 #' @seealso \code{\link{grid_arrange_shared_legend}}, \code{\link{reposition_legend}} #' @examples +#' library(ggplot2) +#' library(grid) #' dsamp <- diamonds[sample(nrow(diamonds), 1000), ] #' (d <- ggplot(dsamp, aes(carat, price)) + #' geom_point(aes(colour = clarity))) @@ -54,6 +56,7 @@ g_legend<-function(a.gplot){ #' @export #' @seealso \code{\link{g_legend}}, \code{\link{reposition_legend}} #' @examples +#' library(ggplot2) #' dsamp <- diamonds[sample(nrow(diamonds), 1000), ] #' p1 <- qplot(carat, price, data = dsamp, colour = clarity) #' p2 <- qplot(cut, price, data = dsamp, colour = clarity) @@ -112,7 +115,7 @@ grid_arrange_shared_legend <- function(..., #' \preformatted{ #' ggplot_gtable(ggplot_build(aplot)) #' } -#' to build a \code{\link[ggplot2]{gtable}} object, and print it to look at the +#' to build a \code{\link[gtable]{gtable}} object, and print it to look at the #' names. #' #' @param aplot a ggplot2 or gtable object. @@ -136,6 +139,7 @@ grid_arrange_shared_legend <- function(..., #' @seealso \code{\link{g_legend}}, \code{\link{grid_arrange_shared_legend}} #' @export #' @examples +#' library(ggplot2) #' dsamp <- diamonds[sample(nrow(diamonds), 1000), ] #' (d <- ggplot(dsamp, aes(carat, price)) + #' geom_point(aes(colour = clarity))) diff --git a/README.Rmd b/README.Rmd index 800a00f..10fb182 100644 --- a/README.Rmd +++ b/README.Rmd @@ -15,7 +15,7 @@ knitr::opts_chunk$set( ) ``` -# splot! - Stefan's plot library of tricks +# splot! --- Stefan's plot library of tricks Just another [ggplot2](http://ggplot2.tidyverse.org) and [knitr](https://yihui.name/knitr/) extension package. @@ -103,6 +103,7 @@ legends. Frequently appearing on [Stack Overflow](http://stackoverflow.com), we bring you `g_legend`: ```{r g_legend,fig.height=3,fig.width=2,fig.cap='The legend grob, by itself.'} +library(grid) legend <- g_legend(d) grid.newpage() grid.draw(legend) diff --git a/README.md b/README.md index a0017d2..d55cc5d 100644 --- a/README.md +++ b/README.md @@ -72,6 +72,7 @@ Scavenging the Internet, we have found some functions that help work with legend Frequently appearing on [Stack Overflow](http://stackoverflow.com), we bring you `g_legend`: ``` r +library(grid) legend <- g_legend(d) grid.newpage() grid.draw(legend) diff --git a/man/brackets.Rd b/man/brackets.Rd index 3ce94a3..f4af419 100644 --- a/man/brackets.Rd +++ b/man/brackets.Rd @@ -37,6 +37,7 @@ It does not re-calculate tick marks, but lets \code{scale_x_*} and \code{scale_y calculate and draw ticks and labels, and then modifies the ticks with brackets. } \examples{ +library(ggplot2) p <- ggplot(mpg, aes(as.factor(cyl), hwy, colour=class)) + geom_point(position=position_jitter(width=0.3)) + theme_bw() + @@ -51,4 +52,3 @@ p # A further adjustment, p + theme(panel.grid.major.x = element_blank()) } - diff --git a/man/coord_capped.Rd b/man/coord_capped.Rd index 21e83ee..eb44e52 100644 --- a/man/coord_capped.Rd +++ b/man/coord_capped.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/coord-capped.r \name{coord_capped_cart} -\alias{capped_horisontal} -\alias{capped_vertical} \alias{coord_capped_cart} \alias{coord_capped_flip} +\alias{capped_horisontal} +\alias{capped_vertical} \title{Cartesian coordinates with capped axis lines.} \usage{ coord_capped_cart(xlim = NULL, ylim = NULL, expand = TRUE, @@ -53,6 +53,7 @@ To ensure the modified axis lines are visible, use \code{theme(panel.border=element_blank(), axis.lines=element_line())}. } \examples{ +library(ggplot2) # Notice how the axis lines of the following plot meet in the lower-left corner. p <- ggplot(mtcars, aes(x = mpg)) + geom_dotplot() + theme_bw() + @@ -77,4 +78,3 @@ p + coord_capped_cart(bottom='none', left='none', right='both', top=brackets_horisontal()) # Although we cannot recommend the above madness. } - diff --git a/man/coord_flex.Rd b/man/coord_flex.Rd index 4f3b124..4d9114e 100644 --- a/man/coord_flex.Rd +++ b/man/coord_flex.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/coord-flex.r \name{coord_flex_cart} \alias{coord_flex_cart} -\alias{coord_flex_fixed} \alias{coord_flex_flip} +\alias{coord_flex_fixed} \title{Cartesian coordinates with flexible options for drawing axes} \usage{ coord_flex_cart(xlim = NULL, ylim = NULL, expand = TRUE, top = waiver(), @@ -51,8 +51,9 @@ and the function should return an \code{\link{absoluteGrob}} object. For examples of modifying the drawn object, see e.g. \code{\link{capped_horisontal}} or \code{\link{brackets_horisontal}}. } -\examples{ +\examples{ +library(ggplot2) # A standard plot p <- ggplot(mtcars, aes(disp, wt)) + geom_point() + @@ -78,7 +79,8 @@ p + coord_flex_cart(left=brackets_vertical(), bottom=capped_horisontal('left')) # Also works with secondary axes: p + scale_y_continuous(sec.axis=sec_axis(~5*., name='wt times 5')) + - coord_flex_cart(left=brackets_vertical(), bottom=capped_horisontal('right'), right=capped_vertical('both', gap=0.02)) + coord_flex_cart(left=brackets_vertical(), bottom=capped_horisontal('right'), + right=capped_vertical('both', gap=0.02)) # Supports the usual 'coord_fixed': @@ -87,4 +89,3 @@ p + coord_flex_fixed(ratio=1.2, bottom=capped_horisontal('right')) # and coord_flip: p + coord_flex_flip(ylim=c(2,5), bottom=capped_horisontal('right')) } - diff --git a/man/facet_rep.Rd b/man/facet_rep.Rd index be4ca77..3a6ef05 100644 --- a/man/facet_rep.Rd +++ b/man/facet_rep.Rd @@ -10,18 +10,13 @@ facet_rep_grid(..., repeat.tick.labels = FALSE) facet_rep_wrap(..., repeat.tick.labels = FALSE) } \arguments{ -\item{...}{Arguments used for \code{\link[ggplot2]{facet_grid}}.} +\item{...}{Arguments used for \code{\link[ggplot2]{facet_grid}} or +\code{\link[ggplot2]{facet_wrap}}.} -\item{repeat.tick.labels}{Logical, removes the labels (numbering) on an axis -when \code{FALSE}.} +\item{repeat.tick.labels}{Logical, removes the labels (numbering) on an inner +axes when \code{FALSE}.} } \description{ \code{\link[ggplot2]{facet_grid}} and \code{\link[ggplot2]{facet_wrap}}, but with axis lines and labels preserved on all panels. } -\examples{ -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - facet_wrap(~class) -} - diff --git a/man/g_legend.Rd b/man/g_legend.Rd index cc00a40..b85971d 100644 --- a/man/g_legend.Rd +++ b/man/g_legend.Rd @@ -21,6 +21,8 @@ applied. Modifying the legend is easiest by applying themes etc. to the ggplot2 object, before calling \code{g_legend}. } \examples{ +library(ggplot2) +library(grid) dsamp <- diamonds[sample(nrow(diamonds), 1000), ] (d <- ggplot(dsamp, aes(carat, price)) + geom_point(aes(colour = clarity))) diff --git a/man/grid_arrange_shared_legend.Rd b/man/grid_arrange_shared_legend.Rd index 717668b..6bf7f46 100644 --- a/man/grid_arrange_shared_legend.Rd +++ b/man/grid_arrange_shared_legend.Rd @@ -34,6 +34,7 @@ Extract legend, combines plots using \code{\link[gridExtra]{arrangeGrob}}, and places legend underneath. } \examples{ +library(ggplot2) dsamp <- diamonds[sample(nrow(diamonds), 1000), ] p1 <- qplot(carat, price, data = dsamp, colour = clarity) p2 <- qplot(cut, price, data = dsamp, colour = clarity) diff --git a/man/reposition_legend.Rd b/man/reposition_legend.Rd index cf7d6ab..40aab8b 100644 --- a/man/reposition_legend.Rd +++ b/man/reposition_legend.Rd @@ -47,10 +47,11 @@ form \code{panel-{col}-{row}}. Use \preformatted{ ggplot_gtable(ggplot_build(aplot)) } -to build a \code{\link[ggplot2]{gtable}} object, and print it to look at the +to build a \code{\link[gtable]{gtable}} object, and print it to look at the names. } \examples{ +library(ggplot2) dsamp <- diamonds[sample(nrow(diamonds), 1000), ] (d <- ggplot(dsamp, aes(carat, price)) + geom_point(aes(colour = clarity))) diff --git a/man/splot.Rd b/man/splot.Rd index 6496e09..cce31fb 100644 --- a/man/splot.Rd +++ b/man/splot.Rd @@ -5,7 +5,7 @@ \alias{splot} \alias{splot-package} \alias{splot-package} -\title{Stefan's plot package} +\title{splot! - Stefan's plot library of tricks} \source{ \url{https://github.com/stefanedwards/splot} } @@ -15,23 +15,50 @@ Just another ggplot2 extension. \section{Functions for axis}{ -See \code{\link{coord_capped_cart}} and \code{\link{coord_flex_cart}}. -The latter is a shorthand version of the former. -It automatically uses \code{\link{capped_horisontal}} and -\code{\link{capped_vertical}}, but both accepts these as well as +See \code{\link{coord_capped_cart}} and \code{\link{coord_flex_cart}}. +The latter is a shorthand version of the former. +It automatically uses \code{\link{capped_horisontal}} and +\code{\link{capped_vertical}}, but both accepts these as well as \code{\link{brackets_horisontal}} and \code{\link{brackets_vertical}}. } +\section{Legends}{ + + +\describe{ + \item{Extract legend}{\code{\link{g_legend}}} + \item{Many plots, one legend}{\code{\link{grid_arrange_shared_legend}}} + \item{Place legend exactly on plot}{\code{\link{reposition_legend}}} +} +} + +\section{Facets}{ + + +\code{\link{facet_rep_grid}} and \code{\link{facet_rep_wrap}} are extensions +to the wellknown \code{\link[ggplot2]{facet_grid}} and +\code{\link[ggplot2]{facet_wrap}} where axis lines and labels are drawn on +all panels. +} + \section{Extending knitr}{ -We automatically load knitr's \code{\link[knitr]{knit_print}} for +We automatically load knitr's \code{\link[knitr]{knit_print}} for data frames and dplyr tables to provide automatic pretty printing of data frame using \code{\link[knitr]{kable}}. See \code{\link{knit_print.data.frame}}. } +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/stefanedwards/splot} + \item Report bugs at \url{https://github.com/stefanedwards/splot/issues} +} + +} \author{ Stefan McKinnon Edwards } diff --git a/vignettes/legends.Rmd b/vignettes/legends.Rmd index d709e66..b41fac3 100644 --- a/vignettes/legends.Rmd +++ b/vignettes/legends.Rmd @@ -32,6 +32,7 @@ in relative measures on the entire plot: ```{r} library(ggplot2) +library(grid) dsamp <- diamonds[sample(nrow(diamonds), 1000), ] (d <- ggplot(dsamp, aes(carat, price)) + geom_point(aes(colour = clarity)) + @@ -64,7 +65,7 @@ library(splot) reposition_legend(d, 'top left') ``` -And it stays there. +And it stays there. Most of the time. ```{r echo=FALSE,fig.cap='**Left:** Base font size set to 22 pt. **Right:** Zoom on plot that is plotted at 150% size.'} @@ -73,7 +74,7 @@ vp2 <- viewport(x=0.5, y=1, width=unit(1.5, 'npc'), height=unit(1.5, 'npc'), jus grid.newpage() vp0 <- current.viewport() pushViewport(vp1) -grid.draw(reposition_legend(d + theme_gray(base_size=26) + theme(legend.position = c(0.06, 0.75)), 'top left', plot=FALSE)) +grid.draw(reposition_legend(d + theme_gray(base_size=26) + theme(legend.position = 'left'), 'top left', plot=FALSE)) grid.draw(g) popViewport() pushViewport(vp2) @@ -81,6 +82,8 @@ grid.draw(reposition_legend(d, 'top left', plot=FALSE)) ``` +The left plot is printed in full at the end of this document. + ### Facets The above demonstration finds the panel named `panel`. This is default. @@ -121,3 +124,16 @@ which was furhter refined by `baptiste` at [ggplot2's wiki](https://github.com/tidyverse/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs). `reposition_legend` was coded by [Stefan McKinnon Edwards](http://www.iysik.com/)/ + +## Footnotes + +Example with `reposition_legend` that didn't quite work: +```{r} +dsamp <- diamonds[sample(nrow(diamonds), 1000), ] +d <- ggplot(dsamp, aes(carat, price)) + + geom_point(aes(colour = clarity)) +reposition_legend(d + theme_gray(base_size=26), 'top left') +``` + + + From 76dd8c24ba951e27eb08bbf6ff639d51ec797137 Mon Sep 17 00:00:00 2001 From: stefanedwards Date: Fri, 28 Apr 2017 16:15:19 +0100 Subject: [PATCH 7/7] Improved documentation and hickups. --- DESCRIPTION | 12 ++-- R/coord-flex.r | 9 ++- R/facet-rep-lab.r | 3 +- R/facet-wrap.r | 3 +- R/ggplot2.r | 16 ++--- README.Rmd | 27 +++++++- man/{ggplot2-ggproto.Rd => splot-ggproto.Rd} | 15 ++--- man/{waiver.Rd => splot-waiver.Rd} | 8 ++- man/splot.Rd | 11 +--- vignettes/capped-axes.Rmd | 68 ++++++++++++++++++++ 10 files changed, 131 insertions(+), 41 deletions(-) rename man/{ggplot2-ggproto.Rd => splot-ggproto.Rd} (73%) rename man/{waiver.Rd => splot-waiver.Rd} (94%) diff --git a/DESCRIPTION b/DESCRIPTION index d9a870d..581e686 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -4,13 +4,15 @@ Title: splot! - Stefan's plot library of tricks URL: https://github.com/stefanedwards/splot BugReports: https://github.com/stefanedwards/splot/issues Version: 0.2.0 -Author@R: person(c('Stefan','McKinnon'), 'Edwards', email='sme@iysik.com', role=c('aut','ctb','cre')) +Author@R: person(c('Stefan','McKinnon'), 'Edwards', email='sme@iysik.com', + role=c('aut','ctb','cre')) Author: Stefan McKinnon Edwards [aut, ctb, cre] Maintainer: Stefan McKinnon Edwards Description: Yet another ggplot2 and knitr extension package. - Includes functions for manipulating ggplot2 legends, - axis lines, and a bit of knitr magic. -Depends: R (>= 3.1.0) + Includes functions for manipulating ggplot2 legends, + axis lines, and a bit of knitr magic. +Depends: + R (>= 3.1.0) Imports: ggplot2 (>= 2.2.0), grid, @@ -21,7 +23,7 @@ Imports: License: GPL-3 + file LICENSE Encoding: UTF-8 LazyData: true -RoxygenNote: 6.0.1 +RoxygenNote: 5.0.1 Collate: 'ggplot2.r' 'brackets.R' diff --git a/R/coord-flex.r b/R/coord-flex.r index f4d5bd7..3be6d08 100644 --- a/R/coord-flex.r +++ b/R/coord-flex.r @@ -166,7 +166,8 @@ flex_render_axis_v <- function(self, scale_details, theme) { # ggproto objects ------------------------------------------------------------- -#' @rdname ggplot2-ggproto +#' @rdname splot-ggproto +#' @keywords internal #' @format NULL #' @usage NULL #' @export @@ -177,7 +178,8 @@ CoordFlexCartesian <- ggplot2::ggproto('CoordFlexCartesian', render_axis_v = flex_render_axis_v ) -#' @rdname ggplot2-ggproto +#' @rdname splot-ggproto +#' @keywords internal #' @format NULL #' @usage NULL #' @export @@ -187,7 +189,8 @@ CoordFlexFlipped <- ggplot2::ggproto('CoordFlexFlipped', `_inherit` = ggplot2:: render_axis_v = flex_render_axis_v ) -#' @rdname ggplot2-ggproto +#' @rdname splot-ggproto +#' @keywords internal #' @format NULL #' @usage NULL #' @export diff --git a/R/facet-rep-lab.r b/R/facet-rep-lab.r index 4b8563b..abd5158 100644 --- a/R/facet-rep-lab.r +++ b/R/facet-rep-lab.r @@ -39,7 +39,8 @@ remove_labels_from_axis <- function(axisgrob) { axisgrob } -#' @rdname ggplot2-ggproto +#' @rdname splot-ggproto +#' @keywords internal #' @format NULL #' @usage NULL #' @export diff --git a/R/facet-wrap.r b/R/facet-wrap.r index 0cdecf9..1379472 100644 --- a/R/facet-wrap.r +++ b/R/facet-wrap.r @@ -14,7 +14,8 @@ facet_rep_wrap <- function(..., repeat.tick.labels=FALSE) { } -#' @rdname ggplot2-ggproto +#' @rdname splot-ggproto +#' @keywords internal #' @format NULL #' @usage NULL #' @export diff --git a/R/ggplot2.r b/R/ggplot2.r index a182388..d90c54e 100644 --- a/R/ggplot2.r +++ b/R/ggplot2.r @@ -5,16 +5,15 @@ #' @import gtable NULL -#' Base ggproto classes for ggplot2 +#' ggproto classes used in splot! #' #' If you are creating a new geom, stat, position, or scale in another package, #' you'll need to extend from \code{ggplot2::Geom}, \code{ggplot2::Stat}, #' \code{ggplot2::Position}, or \code{ggplot2::Scale}. -#' -# -#' @seealso \code{\link[ggplot2]{ggproto}} +#' +#' @seealso \code{\link[ggplot2]{ggproto}}, \code{\link[ggplot2]{ggplot2-ggproto}} #' @keywords internal -#' @name ggplot2-ggproto +#' @name splot-ggproto NULL #' A waiver object. @@ -26,18 +25,19 @@ NULL #' #' Code taken from \file{ggplot2/R/utilities.r}. #' +#' @seealso \code{\link[ggplot2]{waiver}} #' @references ggplot2 -#' @rdname waiver +#' @rdname splot-waiver #' @keywords internal waiver <- function() structure(list(), class = "waiver") #' @param x The object to inquery is a \code{waiver}. -#' @rdname waiver +#' @rdname splot-waiver #' @keywords internal is.waive <- function(x) inherits(x, "waiver") -#' @rdname waiver +#' @rdname splot-waiver #' @keywords internal "%|W|%" <- function(a, b) { if (!is.waive(a)) a else b diff --git a/README.Rmd b/README.Rmd index 10fb182..f7f1a85 100644 --- a/README.Rmd +++ b/README.Rmd @@ -65,7 +65,7 @@ devtools::install_github("stefanedwards/splot") -## Usage +## Axis lines We can display a limit on the axes range. ```{r usage1} @@ -80,12 +80,33 @@ ggplot(mtcars, aes(x=cyl, y=mpg)) + We could also show that the x-axis is categorical (or ordinal): ```{r brackets_demo} -ggplot(mtcars, aes(x=as.factor(cyl), y=mpg)) + +(p <- ggplot(mtcars, aes(x=as.factor(cyl), y=mpg)) + geom_point(position=position_jitter(width=0.1)) + - coord_flex_cart(bottom=brackets_horisontal(), left=capped_vertical('none')) + + coord_flex_cart(bottom=brackets_horisontal(), left=capped_vertical('both')) + theme_light() + theme(panel.border=element_blank(), axis.line = element_line()) +) +``` + +When capping the axis lines, they are never capped further inwards than the ticks! +Look up + +* `coord_capped_cart`, `coord_capped_flip` +* `coord_flex_cart`, `coord_flex_flip`, `coord_flex_fixed` +* `brackets_horisontal`, `brackets_vertical` +* `capped_horisontal`, `capped_vertical` + +## Facets + +Having produced such wonderous axes, it is a pity they are not plotted around +all panels when using faceting. +We have extended both `facet_grid` and `facet_wrap` to produce axis, ticks, and +labels on _all_ panels: + +```{r facets} +p + facet_rep_wrap(~gear, ncol=2, label=label_both) ``` +They work just like the normal ones; look up `facet_rep_grid` and `facet_rep_wrap`. ## Legends diff --git a/man/ggplot2-ggproto.Rd b/man/splot-ggproto.Rd similarity index 73% rename from man/ggplot2-ggproto.Rd rename to man/splot-ggproto.Rd index bc6745a..9824412 100644 --- a/man/ggplot2-ggproto.Rd +++ b/man/splot-ggproto.Rd @@ -1,22 +1,21 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ggplot2.r, R/coord-flex.r, R/facet-rep-lab.r, -% R/facet-wrap.r +% Please edit documentation in R/ggplot2.r, R/coord-flex.r, R/facet-rep-lab.r, R/facet-wrap.r \docType{data} -\name{ggplot2-ggproto} -\alias{ggplot2-ggproto} +\name{splot-ggproto} \alias{CoordFlexCartesian} -\alias{CoordFlexFlipped} \alias{CoordFlexFixed} +\alias{CoordFlexFlipped} \alias{FacetGridRepeatLabels} \alias{FacetWrapRepeatLabels} -\title{Base ggproto classes for ggplot2} +\alias{splot-ggproto} +\title{ggproto classes used in splot!} \description{ If you are creating a new geom, stat, position, or scale in another package, you'll need to extend from \code{ggplot2::Geom}, \code{ggplot2::Stat}, \code{ggplot2::Position}, or \code{ggplot2::Scale}. } \seealso{ -\code{\link[ggplot2]{ggproto}} +\code{\link[ggplot2]{ggproto}}, \code{\link[ggplot2]{ggplot2-ggproto}} } -\keyword{datasets} \keyword{internal} + diff --git a/man/waiver.Rd b/man/splot-waiver.Rd similarity index 94% rename from man/waiver.Rd rename to man/splot-waiver.Rd index 163e86e..96511ea 100644 --- a/man/waiver.Rd +++ b/man/splot-waiver.Rd @@ -1,9 +1,9 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ggplot2.r \name{waiver} -\alias{waiver} -\alias{is.waive} \alias{\%|W|\%} +\alias{is.waive} +\alias{waiver} \title{A waiver object.} \usage{ waiver() @@ -27,4 +27,8 @@ Code taken from \file{ggplot2/R/utilities.r}. \references{ ggplot2 } +\seealso{ +\code{\link[ggplot2]{waiver}} +} \keyword{internal} + diff --git a/man/splot.Rd b/man/splot.Rd index cce31fb..3060761 100644 --- a/man/splot.Rd +++ b/man/splot.Rd @@ -4,7 +4,6 @@ \name{splot} \alias{splot} \alias{splot-package} -\alias{splot-package} \title{splot! - Stefan's plot library of tricks} \source{ \url{https://github.com/stefanedwards/splot} @@ -49,16 +48,8 @@ data frames and dplyr tables to provide automatic pretty printing of data frame using \code{\link[knitr]{kable}}. See \code{\link{knit_print.data.frame}}. -} - -\seealso{ -Useful links: -\itemize{ - \item \url{https://github.com/stefanedwards/splot} - \item Report bugs at \url{https://github.com/stefanedwards/splot/issues} -} - } \author{ Stefan McKinnon Edwards } + diff --git a/vignettes/capped-axes.Rmd b/vignettes/capped-axes.Rmd index 78c59ca..dfb5ace 100644 --- a/vignettes/capped-axes.Rmd +++ b/vignettes/capped-axes.Rmd @@ -77,7 +77,75 @@ ggplot(dat1, aes(gp, y)) + geom_point(position=position_jitter(width=0.2, height ## The `coord` objects +ggplot2's Cartesian coordinates systems, `coord_cartesian`, have been extended +to allow for flexible specification of how axes are drawn. +You've seen them above. +The following table summarises the connection between ggplot2's coord functions +and those of splot!. + + ggplot2 | splot's flexible | splot's short hand +------------------|--------------------|-------------------- +`coord_cartesian` | `coord_flex_cart` | `coord_capped_cart` +`coord_flip` | `coord_flex_flip` | `coord_capped_flip` +`coord_fixed` | `coord_flex_fixed` | -- + +The short hand functions in the table's right column simply are almost identical +to those in the middle column. +If one of the side arguments are specified with a character value, the +relevant axis drawing function is used. You can however choose to use e.g. +`brackets_horisontal` in place. + +### The axis drawing functions + +The functions `capped_horisontal` or `brackets_vertical` returns a function +that is called when ggplot2 prints the plot. It is called with the arguments + + scale_details, axis, scale, position, theme + +and the function should return a grob. +Some pointers to how it is used can be found in ggplot2's help pages; just run +`?"ggplot2-ggproto"`. +In this package, we use ggplot2 to build the axes, then modify in place the +return grobs. + +### Brackets + +The brackets comes in two orientations: +`brackets_horisontal` and `brackets_vertical`. +If you attempt to use a vertical bracket on a horisontal axis, it will fail with +a undescriptive error. + +The bracket functions accept a `direction` argument, which can be used to control +which direction the end-points are pointing: + +```{r brackets} +p <- ggplot(mpg, aes(cyl, hwy, colour=class)) + + geom_point(position=position_jitter(width=0.3)) + + scale_x_continuous(breaks=c(4,5,6,8), sec.axis=dup_axis()) + + scale_y_continuous(sec.axis=dup_axis()) + + coord_flex_cart(bottom=brackets_horisontal(), + top=brackets_horisontal(direction='down'), + left=brackets_vertical(), + right=brackets_vertical(direction='right')) + + my.theme +p +``` + +The look of the brackets are controlled via `theme(axis.ticks)`. +The length of the end-point are controlled via the theme +`theme(axis.ticks.length)`. If these needs to be specified for each margin, +use the argument `tick.length`: + +```{r} +p <- ggplot(mpg, aes(cyl, hwy, colour=class)) + + geom_point(position=position_jitter(width=0.3)) + + coord_flex_cart(bottom=brackets_horisontal(tick.length=unit(0, 'cm')), + left=brackets_vertical(tick.length = unit(1, 'cm'))) + + my.theme +p +``` +As shown above, using `tick.length=unit(0, 'cm')` results in a flat line. ## Facets