Double Axes Support

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

NEWS.md

@@ -1,3 +1,11 @@
+GGally v1.4.0.9000
+-------------
+
+`ggmatrix`
+
+* Added support for secondary axes. (#300)
+
+
 GGally 1.3.3
 ----------------
 

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
 }

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
+}