How to manage the t, b, l, r coordinates of gtable() to plot the secondary y-axis's labels and tick marks properly

Question

I am using facet_wrap and was also able to plot the secondary y-axis. However the labels are not getting plotted near the axis, rather they are plotted very far. I realise i

Answer 1

There were problems with your gtable_add_cols() and gtable_add_grob() commands. I added comments below.

Updated to ggplot2 v2.2.0

library(ggplot2)
library(gtable)
library(grid)
library(data.table)
library(scales)

diamonds$cut <- sample(letters[1:4], nrow(diamonds), replace = TRUE)
dt.diamonds <- as.data.table(diamonds)
d1 <- dt.diamonds[,list(revenue = sum(price),
                        stones = length(price)),
                  by=c("clarity", "cut")]
setkey(d1, clarity, cut)

# The facet_wrap plots
p1 <- ggplot(d1, aes(x = clarity, y = revenue, fill = cut)) +
  geom_bar(stat = "identity") +
  labs(x = "clarity", y = "revenue") +
  facet_wrap( ~ cut, nrow = 2) +
  scale_y_continuous(labels = dollar, expand = c(0, 0)) + 
  theme(axis.text.x = element_text(angle = 90, hjust = 1),
        axis.text.y = element_text(colour = "#4B92DB"), 
        legend.position = "bottom")

p2 <- ggplot(d1, aes(x = clarity, y = stones, colour = "red")) +
  geom_point(size = 4) + 
  labs(x = "", y = "number of stones") + expand_limits(y = 0) +
  scale_y_continuous(labels = comma, expand = c(0, 0)) +
  scale_colour_manual(name = '', values = c("red", "green"), 
      labels =c("Number of Stones")) +
  facet_wrap( ~ cut, nrow = 2) +
  theme(axis.text.y = element_text(colour = "red")) +
  theme(panel.background = element_rect(fill = NA),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_rect(fill = NA, colour = "grey50"),
        legend.position = "bottom")



# Get the ggplot grobs
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)


# Grab the panels from g2 and overlay them onto the panels of g1
pp <- c(subset(g1$layout, grepl("panel", g1$layout$name), select = t:r))
g <- gtable_add_grob(g1, g2$grobs[grepl("panel", g1$layout$name)], 
                     pp$t, pp$l, pp$b, pp$l)


# Function to invert labels
hinvert_title_grob <- function(grob){
widths <- grob$widths
grob$widths[1] <- widths[3]
grob$widths[3] <- widths[1]
grob$vp[[1]]$layout$widths[1] <- widths[3]
grob$vp[[1]]$layout$widths[3] <- widths[1]

grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust 
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust 
grob$children[[1]]$x <- unit(1, "npc") - grob$children[[1]]$x
grob
}

 # Get the y label from g2, and invert it
 index <- which(g2$layout$name == "ylab-l") 
 ylab <- g2$grobs[[index]]                # Extract that grob
 ylab <- hinvert_title_grob(ylab) 


 # Put the y label into g, to the right of the right-most panel
 # Note: Only one column and one y label
 g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos = max(pp$r))

 g <-gtable_add_grob(g,ylab, t = min(pp$t), l = max(pp$r)+1, 
                             b = max(pp$b), r = max(pp$r)+1,
                   clip = "off", name = "ylab-r")


 # Get the y axis from g2, reverse the tick marks and the tick mark labels, 
 # and invert the tick mark labels 
 index <- which(g2$layout$name == "axis-l-1-1")  # Which grob
 yaxis <- g2$grobs[[index]]                    # Extract the grob

 ticks <- yaxis$children[[2]]
 ticks$widths <- rev(ticks$widths)
 ticks$grobs <- rev(ticks$grobs)

 plot_theme <- function(p) {
   plyr::defaults(p$theme, theme_get())
 }

 tml <- plot_theme(p1)$axis.ticks.length   # Tick mark length
 ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") + tml

 ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]])
 yaxis$children[[2]] <- ticks


# Put the y axis into g, to the right of the right-most panel
# Note: Only one column, but two y axes - one for each row of the facet_wrap plot
 g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos = max(pp$r))

 nrows = length(unique(pp$t)) # Number of rows
 g <- gtable_add_grob(g, rep(list(yaxis), nrows), 
               t = unique(pp$t), l = max(pp$r)+1,
               b = unique(pp$b), r = max(pp$r)+1, 
               clip = "off", name = paste0("axis-r-", 1:nrows))



# Get the legends
leg1 <- g1$grobs[[which(g1$layout$name == "guide-box")]]
leg2 <- g2$grobs[[which(g2$layout$name == "guide-box")]]

# Combine the legends
g$grobs[[which(g$layout$name == "guide-box")]] <-
    gtable:::cbind_gtable(leg1, leg2, "first")

grid.newpage()
grid.draw(g)

---

SO is not a tutorial site, and this might incur the wrath of other SO users, but there is too much for a comment.

Draw a graph with one plot panel only (i.e., no facetting),

library(ggplot2)

p <- ggplot(mtcars, aes(x = mpg, y = disp)) + geom_point()

Get the ggplot grob.

g <- ggplotGrob(p)

Explore the plot grob:
1) gtable_show_layout() give a diagram of the plot's gtable layout. The big space in the middle is the location of the plot panel. Columns to the left of and below the panel contain the y and x axes. And there is a margin surrounding the whole plot. The indices give the location of each cell in the array. Note, for instance, that the panel is located in the third row of the fourth column.

gtable_show_layout(g)  

2) The layout dataframe. g$layout returns a dataframe which contains the names of the grobs contained in the plot along with their locations within the gtable: t, l, b, and r (standing for top, left, right, and bottom). Note, for instance, that the panel is located at t=3, l=4, b=3, r=4. That is the same panel location that was obtained above from the diagram.

 g$layout

3) The diagram of the layout tries to give the heights and widths of the rows and columns, but they tend to overlap. Instead, use g$widths and g$heights. The 1null width and height is the width and height of the plot panel. Note that 1null is the 3rd height and the 4th width - 3 and 4 again.

Now draw a facet_wrap and a facet_grid plot.

p1 <- ggplot(mtcars, aes(x = mpg, y = disp)) + geom_point() +
   facet_wrap(~ carb, nrow = 1)

p2 <- ggplot(mtcars, aes(x = mpg, y = disp)) + geom_point() +
   facet_grid(. ~ carb)

g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)

The two plots look the same, but their gtables differ. Also, the names of the component grobs differ.

Often it is convenient to get a subset of the layout dataframe containing the indices (i.e., t, l, b, and r) of grobs of a common type; say all the panels.

pp1 <- subset(g1$layout, grepl("panel", g1$layout$name), select = t:r)
pp2 <- subset(g2$layout, grepl("panel", g2$layout$name), select = t:r)

Note for instance that all the panels are in row 4 (pp1$t, pp2$t).
pp1$r refers to the columns that contain the plot panels;
pp1$r + 1 refers to the columns to the right of the panels;
max(pp1$r) refers to the right most column that contains a panel;
max(pp1$r) + 1 refers to the column to the right of the right most column that contains a panel;
and so forth.

Finally, draw a facet_wrap plot with more than one row.

p3 <- ggplot(mtcars, aes(x = mpg, y = disp)) + geom_point() +
   facet_wrap(~ carb, nrow = 2)
g3 <- ggplotGrob(p3)

Explore the plot as before, but also subset the layout data frame to contain the indices of the panels.

pp3 <- subset(g3$layout, grepl("panel", g3$layout$name), select = t:r)

As you would expect, pp3 tells you that the plot panels are located in three columns (4, 7, and 10) and two rows (4 and 8).

These indices are used when adding rows or columns to the gtable, and when adding grobs to a gtable. Check these commands with ?gtable_add_rows and gtable_add_grob.

Also, learn some grid, especially how to construct grobs, and the use of units (some resources are given in the r-grid tag here on SO.