diff --git a/DESCRIPTION b/DESCRIPTION index 30dde827b..8cbc21f5b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: GGally -Version: 1.4.0 +Version: 1.4.0.9000 License: GPL (>= 2.0) Title: Extension to 'ggplot2' Type: Package diff --git a/NEWS.md b/NEWS.md index 418008cd0..f08f209fd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,11 @@ +GGally v1.4.0.9000 +------------- + +`ggmatrix` + +* Added support for secondary axes. (#300) + + GGally 1.3.3 ---------------- diff --git a/R/ggmatrix_gtable.R b/R/ggmatrix_gtable.R index 129b0382f..6c2baeb4b 100644 --- a/R/ggmatrix_gtable.R +++ b/R/ggmatrix_gtable.R @@ -29,7 +29,7 @@ ggmatrix_gtable <- function( progress_fn <- pm$progress } else { warning("Please use the 'progress' parameter in your ggmatrix-like function call. See ?ggmatrix_progress for a few examples. ggmatrix_gtable 'progress' and 'progress_format' will soon be deprecated.", immediate = TRUE) - + # has progress variable defined # overrides pm$progress if (missing(progress_format)) { @@ -161,8 +161,12 @@ ggmatrix_gtable <- function( # init the axis sizes left_axis_sizes <- numeric(pm$nrow + 1) bottom_axis_sizes <- numeric(pm$ncol + 1) + right_axis_sizes <- numeric(pm$nrow + 1) + top_axis_sizes <- numeric(pm$ncol + 1) axis_l_grob_pos <- pmg_layout_grob_pos[str_detect(pmg_layout_name, "axis-l")] axis_b_grob_pos <- pmg_layout_grob_pos[str_detect(pmg_layout_name, "axis-b")] + axis_r_grob_pos <- pmg_layout_grob_pos[str_detect(pmg_layout_name, "axis-r")] + axis_t_grob_pos <- pmg_layout_grob_pos[str_detect(pmg_layout_name, "axis-t")] # change the plot size ratios x_proportions <- pm$xProportions @@ -213,28 +217,52 @@ ggmatrix_gtable <- function( pg <- plot_gtable(p) # if the left axis should be added - if (j == 1 && pm$showYAxisPlotLabels) { - left_axis_sizes[i] <- axis_size_left(pg) - - pmg <- add_left_axis( - pmg, pg, - show_strips = ( - (i == 1) && is.null(pm$showStrips) - ) || isTRUE(pm$showStrips), - grob_pos = axis_l_grob_pos[i] - ) + if (pm$showYAxisPlotLabels) { + if (j == 1) { + left_axis_sizes[i] <- axis_size_left(pg) + + pmg <- add_left_axis( + pmg, pg, + show_strips = ( + (i == 1) && is.null(pm$showStrips) + ) || isTRUE(pm$showStrips), + grob_pos = axis_l_grob_pos[i] + ) + } else if (j == pm$ncol) { + right_axis_sizes[i] <- axis_size_right(pg) + + pmg <- add_right_axis( + pmg, pg, + show_strips = ( + (i == 1) && is.null(pm$showStrips) + ) || isTRUE(pm$showStrips), + grob_pos = axis_r_grob_pos[i] + ) + } } # if the bottom axis should be added - if (i == pm$nrow && pm$showXAxisPlotLabels) { - bottom_axis_sizes[j] <- axis_size_bottom(pg) - - pmg <- add_bottom_axis( - pmg, pg, - show_strips = ( - (j == pm$ncol) && is.null(pm$showStrips) - ) || isTRUE(pm$showStrips), - grob_pos = axis_b_grob_pos[j] - ) + if (pm$showXAxisPlotLabels) { + if (i == pm$nrow) { + bottom_axis_sizes[j] <- axis_size_bottom(pg) + + pmg <- add_bottom_axis( + pmg, pg, + show_strips = ( + (j == pm$ncol) && is.null(pm$showStrips) + ) || isTRUE(pm$showStrips), + grob_pos = axis_b_grob_pos[j] + ) + } else if (i == 1) { + top_axis_sizes[j] <- axis_size_top(pg) + + pmg <- add_top_axis( + pmg, pg, + show_strips = ( + (j == pm$ncol) && is.null(pm$showStrips) + ) || isTRUE(pm$showStrips), + grob_pos = axis_t_grob_pos[j] + ) + } } # grab plot panel and insert @@ -266,6 +294,22 @@ ggmatrix_gtable <- function( pmg_key = "heights" #stop_msg = "bottom axis height issue!! Fix!" ) + pmg <- set_max_axis_size( + pmg, + axis_sizes = right_axis_sizes, + layout_name = "axis-r", + layout_cols = c("l", "r"), + pmg_key = "widths" + #stop_msg = "left axis width issue!! Fix!" + ) + pmg <- set_max_axis_size( + pmg, + axis_sizes = top_axis_sizes, + layout_name = "axis-t", + layout_cols = c("t", "b"), + pmg_key = "heights" + #stop_msg = "bottom axis height issue!! Fix!" + ) pmg } diff --git a/R/ggmatrix_gtable_helpers.R b/R/ggmatrix_gtable_helpers.R index 71036466f..85b0f5c21 100644 --- a/R/ggmatrix_gtable_helpers.R +++ b/R/ggmatrix_gtable_helpers.R @@ -35,11 +35,28 @@ axis_list <- (function(){ "heights", unitTo = "cm", valueOnly = TRUE ) + axis_size_right <- axis_label_size_wrapper( + grid::convertWidth, + "axis-r", + "widths", + unitTo = "cm", valueOnly = TRUE + ) + axis_size_top <- axis_label_size_wrapper( + grid::convertHeight, + "axis-t", + "heights", + unitTo = "cm", valueOnly = TRUE + ) - list(axis_size_left, axis_size_bottom) + list( + axis_size_left, axis_size_bottom, + axis_size_right, axis_size_top + ) })() axis_size_left <- axis_list[[1]] axis_size_bottom <- axis_list[[2]] +axis_size_right <- axis_list[[3]] +axis_size_top <- axis_list[[4]] # add_correct_label <- function(pmg, pm, @@ -149,6 +166,51 @@ add_bottom_axis <- function(pmg, pg, show_strips, grob_pos) { pmg } +add_right_axis <- function(pmg, pg, show_strips, grob_pos) { + layout <- pg$layout + layout_name <- layout$name + + # axis layout info + al <- layout[str_detect(layout_name, "axis-r"), ] + + if (show_strips) { + alx <- layout[str_detect(layout_name, "axis-r|strip-t|strip-b"), ] + } else { + alx <- al + } + + # get only the axis right objects (and maybe strip top spacer) + axis_panel <- pg[min(alx$b):max(alx$t), min(al$l)] + + # force to align right + axis_panel <- gtable::gtable_add_cols(axis_panel, grid::unit(1, "null"), 1) + pmg$grobs[[grob_pos]] <- axis_panel + + pmg +} + + +add_top_axis <- function(pmg, pg, show_strips, grob_pos) { + layout <- pg$layout + layout_name <- layout$name + # axis layout info + al <- layout[str_detect(layout_name, "axis-t"), ] + + if (show_strips) { + alx <- layout[str_detect(layout_name, "axis-t|strip-r|strip-l"), ] + } else { + alx <- al + } + + # get only the axis left objects (and maybe strip top spacer) + axis_panel <- pg[min(al$t), min(alx$l):max(alx$r)] + + # force to align top + axis_panel <- gtable::gtable_add_rows(axis_panel, grid::unit(1, "null"), 0) + pmg$grobs[[grob_pos]] <- axis_panel + + pmg +}