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 it all will get resolved if I understand how to manipulate the coordinate system of the gtable (t,b,l,r) of the grobs. Could someone explain how and what they actually depict - t:r = c(4,8,4,4) means what.

There are many links for secondary yaxis with ggplot, however when nrow/ncol is more than 1, they fails. So please teach me the basics of grid geometry and grobs location management.

Edit : the Code

this is the final code written by me :

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

# Data  
diamonds$cut <- sample(letters[1:13], 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) +
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) +
  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
xx <- ggplot_build(p1)
g1 <- ggplot_gtable(xx)

yy <- ggplot_build(p2)
g2 <- ggplot_gtable(yy)

nrow = length(unique(xx$panel$layout$ROW))
ncol = length(unique(xx$panel$layout$COL))
npanel = length(xx$panel$layout$PANEL)

pp <- c(subset(g1$layout, grepl("panel", g1$layout$name), se = t:r))
g <- gtable_add_grob(g1, g2$grobs[grepl("panel", g1$layout$name)], 
                     pp$t, pp$l, pp$b, pp$l)

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
}

j = 1
k = 0

for(i in 1:npanel){
  if ((i %% ncol == 0) || (i == npanel)){
    k = k + 1
    index <- which(g2$layout$name == "axis_l-1")  # Which grob
    yaxis <- g2$grobs[[index]]                    # Extract the grob
    ticks <- yaxis$children[[2]]
    ticks$widths <- rev(ticks$widths)
    ticks$grobs <- rev(ticks$grobs)
    ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc")
    ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]])
    yaxis$children[[2]] <- ticks
    if (k == 1)#to ensure just once d secondary axisis printed 
      g <- gtable_add_cols(g,g2$widths[g2$layout[index,]$l],
              max(pp$r[j:i]))
      g <- gtable_add_grob(g,yaxis,max(pp$t[j:i]),max(pp$r[j:i])+1,
                 max(pp$b[j:i])
                     , max(pp$r[j:i]) + 1, clip = "off", name = "2ndaxis")
     j = i + 1
  }
}

# inserts the label for 2nd y-axis 
loc_1st_yaxis_label <- c(subset(g$layout, grepl("ylab", g$layout$name), se  
                       = t:r)) 
loc_2nd_yaxis_max_r <- c(subset(g$layout, grepl("2ndaxis", g$layout$name), 
                      se = t:r))
zz <- max(loc_2nd_yaxis_max_r$r)+1
loc_1st_yaxis_label$l <- zz
loc_1st_yaxis_label$r <- zz

index <- which(g2$layout$name == "ylab") 
ylab <- g2$grobs[[index]]                # Extract that grob
ylab <- hinvert_title_grob(ylab)  
ylab$children[[1]]$rot <- ylab$children[[1]]$rot + 180
g <- gtable_add_grob(g, ylab, loc_1st_yaxis_label$t, loc_1st_yaxis_label$l
                     , loc_1st_yaxis_label$b, loc_1st_yaxis_label$r
                     , clip = "off", name = "2ndylab")
grid.draw(g)

@Sandy here is the code and its output

only trouble was that in the last row the secondary y-axis labels are inside the panels.I tried to solve this but not able to

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.