Dual y axis in ggplot2 for multiple panel figure - r

We can not easily create the dual y axis with ggplot2.
kohske provided a solution to add dual y axis for single panel figures (http://rpubs.com/kohske/dual_axis_in_ggplot2)
#Andreas show an example to align two plots with ggplot2 (still single panel figures) (Plot with 2 y axes, one y axis on the left, and another y axis on the right)
These tricks can not work if figures have multiple panels (created by geom_wrap or geom_grid), e.g. 4 panel figure below. I would like to add the axis of p1 to the right side of panels of merged figure.
EDIT: I removed my codes here and post my own solution as an answer. Just in case some one needs it.

I post my own solution as an answer, just in case some one needs it.
library(ggplot2)
library(gtable)
library(grid)
df1 <- expand.grid(list(x = 1:10, z = 1:4, col = 1:2))
df2 <- df1
df1$y <- df1$x * df1$x + df1$col * 10
df2$y <- 4 * df2$x + df1$col * 10
p1 <- ggplot(df1)
p1 <- p1 + geom_point(aes(x, y, colour = factor(col)))
p1 <- p1 + facet_wrap(~z)
p1 <- p1 + ylab('Y label for figure 1')
p1 <- p1 + theme(legend.position = 'bottom',
plot.margin = unit(c(1, 2, 0.5, 0.5), 'cm'))
p2 <- ggplot(df2)
p2 <- p2 + geom_line(aes(x, y, colour = factor(col)))
p2 <- p2 + facet_wrap(~z)
p2 <- p2 + ylab('Y label for figure 2')
p2 <- p2 + theme(legend.position = 'bottom',
plot.margin = unit(c(1, 2, 0.5, 0.5), 'cm'))
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))
combo_grob <- g2
pos <- length(combo_grob) - 1
combo_grob$grobs[[pos]] <- cbind(g1$grobs[[pos]],
g2$grobs[[pos]], size = 'first')
panel_num <- length(unique(df1$z))
for (i in seq(panel_num))
{
# grid.ls(g1$grobs[[i + 1]])
panel_grob <- getGrob(g1$grobs[[i + 1]], 'geom_point.points',
grep = TRUE, global = TRUE)
combo_grob$grobs[[i + 1]] <- addGrob(combo_grob$grobs[[i + 1]],
panel_grob)
}
pos_a <- grep('axis_l', names(g1$grobs))
axis <- g1$grobs[pos_a]
for (i in seq(along = axis))
{
if (i %in% c(2, 4))
{
pp <- c(subset(g1$layout, name == paste0('panel-', i), se = t:r))
ax <- axis[[1]]$children[[2]]
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)
ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.5, "cm")
ax$grobs[[2]]$x <- ax$grobs[[2]]$x - unit(1, "npc") + unit(0.8, "cm")
combo_grob <- gtable_add_cols(combo_grob, g2$widths[g2$layout[pos_a[i],]$l], length(combo_grob$widths) - 1)
combo_grob <- gtable_add_grob(combo_grob, ax, pp$t, length(combo_grob$widths) - 1, pp$b)
}
}
pp <- c(subset(g1$layout, name == 'ylab', se = t:r))
ia <- which(g1$layout$name == "ylab")
ga <- g1$grobs[[ia]]
ga$rot <- 270
ga$x <- ga$x - unit(1, "npc") + unit(1.5, "cm")
combo_grob <- gtable_add_cols(combo_grob, g2$widths[g2$layout[ia,]$l], length(combo_grob$widths) - 1)
combo_grob <- gtable_add_grob(combo_grob, ga, pp$t, length(combo_grob$widths) - 1, pp$b)
combo_grob$layout$clip <- "off"
grid.draw(combo_grob)
P1:
P2:
Merged:

Related

Adding a second y-axis and line over a bar plot

Following is my data
df <- data.frame(Lab = c("Queen II", "MMH", "Berea", "Maluti", "Motebang"),
Expected = c(13200, 5280, 5280, 2640, 5280),
Actual = c(8759, 761, 2263, 2210, 6100),
utili_pct = c(66.35, 14.41, 42.86, 83.71, 115.53))
and I have tried to plot a bar chat which includes a line over the chart.
step 1
# I Converted numeric variable "Actual" to a factor
df$Actualx <- as.factor(df$Actual)
This was so that I could plot a chart with two-factor variables vs one numeric
So I tidy the data and ran the plot this way but the axis scale became no ordered.
tidy_Data = df %>% gather(key, value, Actualx, Expected)
ggplot(tidy_Data, aes(x=Lab, y=value, fill=key)) +
geom_bar(stat = "identity", position = position_dodge(0.8)) `
Futhermore,
I tried to add a line utili_ptc and the second axis, but the scale is giving me a hard time,
The line does not align with the bars.
ggplot(tidy_Data, aes(x=Lab, y=value, fill=key)) +
geom_bar(stat = "identity", position = position_dodge(0.8)) +
geom_line(aes(x=Lab, y=utili_pct), color = "green", group = 1)
There's a post about why using a seconday y-axis is frowned upon here
ggplot with 2 y axes on each side and different scales
To answer your specific question, I did a quick search and found this post and used it construct your diagram. Please have a look at it and see if you can understand
https://rpubs.com/kohske/dual_axis_in_ggplot2
library(ggplot2)
library(gtable)
library(grid)
grid.newpage()
# two plots
p1 <- ggplot(tidy_Data, aes(x=Lab, y=value, fill=key)) +
geom_bar(stat = "identity", position = position_dodge(0.8)) +
theme(legend.position = 'top')
p2 <- ggplot(tidy_Data, aes(x = 1:10, y = utili_pct)) + geom_line() +
theme_bw() +
theme(panel.background = element_rect(fill = NA))
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))
pp <- c(subset(g1$layout, name == "panel", se = t:r))
g <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], pp$t,
pp$l, pp$b, pp$l)
# axis tweaks
ia <- which(g2$layout$name == "axis-l")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)
ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)
# draw it
grid.draw(g)
Thank you very very much for your guidance. I have finally been able to plot the chart the way I wanted using your code.
library("tidyverse")
library("ggplot2")
library("gtable")
library("grid")
df <- data.frame(Lab = c("Queen II", "MMH", "Berea", "Maluti", "Motebang"), Actual = c(8759, 761, 2263, 2210, 5100), utili_pct = c(66.35, 14.41, 42.86, 83.71, 96.59), Expected = c(13200, 5280, 5280, 2640, 5280),stringsAsFactors = F)
tidy the data
tidy_Data <- df%>% gather(key,value, Actual, Expected)
grid.newpage()
two plots
p1 <- ggplot(tidy_Data, aes(x=Lab, y=value, fill=key)) + geom_bar(stat = "identity", position = position_dodge(0.8)) + theme(legend.position = "bottom")
p2 <- ggplot(df, aes(x=1:5, y=utili_pct)) + geom_line() + ylim(10,100) + theme_bw() + theme(panel.background = element_rect(fill = NA))
extract gtable
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))
Overlap the panel of the 2nd plot on that of the 1st plot
pp <- c(subset(g1$layout, name == "panel", se = t:r))
g <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], pp$t,pp$l, pp$b, pp$l)
axis tweaks
ia <- which(g2$layout$name == "axis-l")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)
ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)
draw it
grid.draw(g)

Dual y axis - label and background gridlines of right y axis

I need to make a dual y axis in ggplot2. I have tried to follow #kohske solution published here: http://rpubs.com/kohske/dual_axis_in_ggplot2 However, two things are still undesired and I can't figure out how to solve them.
1. In the plot below the label of right y axis is absent, while I want to make it present
2. gridlines for right y axis is shown on top of bar plot, while it should be in the background.
Here's the plot:
and the code:
library(ggplot2)
library(grid)
library(gtable)
grid.newpage()
p1 <- ggplot(ex,
aes(factor(subgroups, levels = c('Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday',
'Saturday', 'Sunday')),
y_left)) +
geom_bar(fill = rgb(16/255, 72/255, 128/255), stat = 'identity') +
theme_bw() +
labs(x = 'weekday')
p2 <- ggplot(ex, aes(factor(subgroups,
levels = c('Monday', 'Tuesday', 'Wednesday',
'Thursday', 'Friday', 'Saturday', 'Sunday')), y_right)) +
geom_line(colour = rgb(237/255, 165/255, 6/255), group = 1) +
geom_point(color = rgb(237/255, 165/255, 6/255), size = 3) +
scale_y_continuous(limits = c(0, 180)) +
labs(y = 'name for y_left axis') +
theme_bw() %+replace%
theme(panel.background = element_rect(fill = NA))
# extract gtable
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))
# overlap the panel of 2nd plot on that of 1st plot
pp <- c(subset(g1$layout, name == "panel", se = t:r))
g <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], pp$t,
pp$l, pp$b, pp$l)
# axis tweaks
ia <- which(g2$layout$name == "axis-l")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)
ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)
# draw it
grid.draw(g)
They added a secondary axis option to ggplot a while back. Try putting both geoms on a single plot and adding scale_y_continuous(sec.axis = sec_axis(~.-280), name = "My Second Axis").
Instead of simple subtraction, you can compute a ratio. This can be done inline, using something like sec.axis = sec_axis(~. * max(myData$y) / max(myData$y2)), or you can compute it ahead of time and apply it to both the 2nd axis and the data you intend to be read on the second axis, like this:
library(ggplot2)
# Create Sample Data
myData <- data.frame(x = seq(1, 10, length.out = 10),
y = seq(0, 20, length.out = 10),
y2 = seq(0, 100, length.out = 10))
myData.ratio <- max(myData$y) / max(myData$y2)
ggplot(myData, (aes(x=x, y=y))) +
geom_bar(stat="identity", aes(y=y2 * myData.ratio), fill = "lightblue") +
geom_line(color="red") +
geom_point(color="red") +
scale_y_continuous(sec.axis = sec_axis(~. / myData.ratio, name = "My Second Axis"))
Note that we're multiplying the actual values by the ratio in the geom and dividing by it when computing the axis.
Output:

Combine two ggplots one x-axis and two y-axis

I want to combine to ggplots. I tried the following code, but the result is not very good. In the combine plot I have problems with the second y-axis and the errorbars of plot 1.
Plot 1
pdf(file=paste("./plots/", "Cog1rt.pdf", sep=""), width=16, height=11)
p1 <- ggplot(data=datcom, aes(x=group, y=value, fill=group)) +
geom_bar(position="dodge", size=.3,stat="identity") +
geom_errorbar( aes(ymax=value+1*value2, ymin=value, width=0.1,colour=group)) +
labs(x="\n Gruppe", y="Reaktionszeit\n") +
facet_wrap(~rt) +
theme_bw() %+replace% theme(panel.background = element_rect(fill = NA))
print(p1)
dev.off()
Plot 2
pdf(file="./plots/Cog1errl.pdf", width=4, height=3.5)
p2 <- ggplot(data=datcom, aes(x=group, y=value3,fill=group)) +
geom_errorbar(aes(ymax=value3+1*value4, ymin=value3-1*value4,width=0.6)) +
geom_point() +
facet_wrap(~rt) +
ylab("Fehler") +
theme_bw() %+replace% theme(panel.background = element_rect(fill = NA))
print(p2)
dev.off()
Combine
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))
pp <- c(subset(g1$layout, grepl("panel",name) , se = t:r))
g <- gtable_add_grob(g1, g2$grobs[grep("panel",g2$layout$name)], pp$t,
pp$l, pp$b, pp$l)
ia <- which(grepl("axis_l",g2$layout$name) | grepl("axis-l",g2$layout$name) )
ga <- g2$grobs[ia]
axis_idx <- as.numeric(which(sapply(ga,function(x) !is.null(x$children$axis))))
i <- length(axis_idx)
ax <- ga[[axis_idx[i]]]$children$axis
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)
ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(-0.8, "npc") + unit(-0.1, "cm")
g <- gtable_add_cols(g, g2$widths[12], 12)
g <- gtable_add_grob(g, ax, pp$t[axis_idx[i]], length(g$widths) - 3, pp$b[axis_idx[i]])
grid.newpage()
grid.draw(g)

R ggplot2 Dual y-axis facet wrap, one histogram and other line

I have two facet wrapped plots, p1 and p2
p1
p2
As you can see, the x-axis values line up for both plots, however the y-axis values differ quite drastically. I would like to overlay p2 onto p1, keeping the p1 y axis on the left and creating another p2 y-axis on the right.
This is what I have right now, but I am unsure of how to correctly combine grobs for p1 and p2.
library(ggplot2)
library(gtable)
library(grid)
themer <- theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
panel.margin = unit(0, "lines"),
strip.background = element_rect(fill="#F8F8F8"))
p2 <- ggplot(normaldens, aes(y=density,x=predicted)) +
geom_line(color="red") +
facet_wrap(~ motif) +
labs(title=paste("Methylation Score:",motif_f[j]),x="Methylation Score",y="Density") +
themer
p1 <- ggplot(dat, aes(x=score)) +
geom_histogram( binwidth = bin_width,col="red",fill="blue",alpha=0.2) +
facet_wrap(~ motif) +
labs(title=paste("Methylation Score:",motif_f[j]),x="Methylation Score",y="Counts") +
themer
###### COMBINE GROBS #######
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))
combo_grob <- g2
pos <- length(combo_grob) - 1
combo_grob$grobs[[pos]] <- cbind(g1$grobs[[pos]],
g2$grobs[[pos]], size = 'first')
panel_num <- length(unique(df1$z))
for (i in seq(panel_num))
{
# grid.ls(g1$grobs[[i + 1]])
panel_grob <- getGrob(g1$grobs[[i + 1]], 'geom_point.points',
grep = TRUE, global = TRUE)
combo_grob$grobs[[i + 1]] <- addGrob(combo_grob$grobs[[i + 1]],
panel_grob)
}
pos_a <- grep('axis_l', names(g1$grobs))
axis <- g1$grobs[pos_a]
for (i in seq(along = axis))
{
if (i %in% c(2, 4))
{
pp <- c(subset(g1$layout, name == paste0('panel-', i), se = t:r))
ax <- axis[[1]]$children[[2]]
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)
ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.5, "cm")
ax$grobs[[2]]$x <- ax$grobs[[2]]$x - unit(1, "npc") + unit(0.8, "cm")
combo_grob <- gtable_add_cols(combo_grob, g2$widths[g2$layout[pos_a[i],]$l], length(combo_grob$widths) - 1)
combo_grob <- gtable_add_grob(combo_grob, ax, pp$t, length(combo_grob$widths) - 1, pp$b)
}
}
pp <- c(subset(g1$layout, name == 'ylab', se = t:r))
ia <- which(g1$layout$name == "ylab")
ga <- g1$grobs[[ia]]
ga$rot <- 270
ga$x <- ga$x - unit(1, "npc") + unit(1.5, "cm")
combo_grob <- gtable_add_cols(combo_grob, g2$widths[g2$layout[ia,]$l], length(combo_grob$widths) - 1)
combo_grob <- gtable_add_grob(combo_grob, ga, pp$t, length(combo_grob$widths) - 1, pp$b)
combo_grob$layout$clip <- "off"
grid.draw(combo_grob)
And I get this error, which I know has to do something with the way I'm combining the two gtables.
Error in gList(list(x = 0.5, y = 0.5, width = 1, height = 1, just = "centre", :
only 'grobs' allowed in "gList"
I don't think you can do a second y-axis within ggplot2, but what about plotting both density and histogram in a single plot and using bar labeling for the counts (instead of trying to hack a second y-axis). Here's an example (using the built-in iris dataset):
First, we'll calculate maximum values of density and count and use these to create scale factors that we'll use to programmatically ensure that the histogram and density plot have about the same vertical scale.
library(dplyr)
# Find maximum value of density
densMax = iris %>% group_by(Species) %>%
summarise(dens = max(density(Sepal.Length)[["y"]])) %>%
filter(dens == max(dens))
# Find maximum value of bin count
countMax = iris %>%
group_by(Species,
bins=cut(Sepal.Length, seq(floor(min(Sepal.Length)),
ceiling(max(Sepal.Length)),
0.25), right=FALSE)) %>%
summarise(count=n()) %>%
ungroup() %>% filter(count==max(count))
Now we scale the histogram bars to the size of the density plot. sf is the scale factor:
ggplot(iris, aes(x=Sepal.Length, sf = countMax$count/densMax$dens)) +
geom_histogram(fill=hcl(195,100,65), colour="grey50", binwidth=0.25) +
geom_density(colour="red", aes(y=..density.. * sf)) +
facet_wrap(~ Species) +
themer
Alternatively, you could go in the other direction, and scale the density plot to the histogram:
# Scale histogram bars to size of density plot
ggplot(iris, aes(x=Sepal.Length, sf = densMax$dens/countMax$count)) +
geom_histogram(aes(y=..count..*sf),
fill=hcl(195,100,65), colour="grey50", binwidth=0.25) +
stat_bin(aes(label=..count.., y=..count..*0.5*sf),
geom="text", size=4, color="white", binwidth=0.25) +
geom_density(colour="red") +
facet_wrap(~ Species) +
themer +
labs(y="Density")

How to use facets with a dual y-axis ggplot

I have been trying to extend my scenario from here to make use of facets (specifically facet_grid()).
I have seen this example, however I can't seem to get it to work for my geom_bar() and geom_point() combo. I attempted to use the code from the example just changing from facet_wrap to facet_grid which also seemed to make the first layer not show.
I am very much a novice when it comes to grid and grobs so if someone can give some guidance on how to make P1 show up with the left y axis and P2 show up on the right y axis that would be great.
Data
library(ggplot2)
library(gtable)
library(grid)
library(data.table)
library(scales)
grid.newpage()
dt.diamonds <- as.data.table(diamonds)
d1 <- dt.diamonds[,list(revenue = sum(price),
stones = length(price)),
by=c("clarity","cut")]
setkey(d1, clarity,cut)
p1 & p2
p1 <- ggplot(d1, aes(x=clarity,y=revenue, fill=cut)) +
geom_bar(stat="identity") +
labs(x="clarity", y="revenue") +
facet_grid(. ~ 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=6) +
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_grid(. ~ 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")
Attempt to combine (based on example linked above)
This fails in the first for loop, I suspect to the hard coding of geom_point.points, however I don't know how to make it suit my charts (or fluid enough to suit a variety of charts)
# extract gtable
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))
combo_grob <- g2
pos <- length(combo_grob) - 1
combo_grob$grobs[[pos]] <- cbind(g1$grobs[[pos]],
g2$grobs[[pos]], size = 'first')
panel_num <- length(unique(d1$cut))
for (i in seq(panel_num))
{
grid.ls(g1$grobs[[i + 1]])
panel_grob <- getGrob(g1$grobs[[i + 1]], 'geom_point.points',
grep = TRUE, global = TRUE)
combo_grob$grobs[[i + 1]] <- addGrob(combo_grob$grobs[[i + 1]],
panel_grob)
}
pos_a <- grep('axis_l', names(g1$grobs))
axis <- g1$grobs[pos_a]
for (i in seq(along = axis))
{
if (i %in% c(2, 4))
{
pp <- c(subset(g1$layout, name == paste0('panel-', i), se = t:r))
ax <- axis[[1]]$children[[2]]
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)
ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.5, "cm")
ax$grobs[[2]]$x <- ax$grobs[[2]]$x - unit(1, "npc") + unit(0.8, "cm")
combo_grob <- gtable_add_cols(combo_grob, g2$widths[g2$layout[pos_a[i],]$l], length(combo_grob$widths) - 1)
combo_grob <- gtable_add_grob(combo_grob, ax, pp$t, length(combo_grob$widths) - 1, pp$b)
}
}
pp <- c(subset(g1$layout, name == 'ylab', se = t:r))
ia <- which(g1$layout$name == "ylab")
ga <- g1$grobs[[ia]]
ga$rot <- 270
ga$x <- ga$x - unit(1, "npc") + unit(1.5, "cm")
combo_grob <- gtable_add_cols(combo_grob, g2$widths[g2$layout[ia,]$l], length(combo_grob$widths) - 1)
combo_grob <- gtable_add_grob(combo_grob, ga, pp$t, length(combo_grob$widths) - 1, pp$b)
combo_grob$layout$clip <- "off"
grid.draw(combo_grob)
EDIT to attempt to make workable for facet_wrap
The following code still works with facet_grid using ggplot2 2.0.0
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))
pp <- c(subset(g1$layout, name == "panel", se = t:r))
g <- gtable_add_grob(g1, g2$grobs[which(g2$layout$name == "panel")], pp$t,
pp$l, pp$b, pp$l)
# axis tweaks
ia <- which(g2$layout$name == "axis-l")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)
ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g <- gtable_add_grob(g, ax, unique(pp$t), length(g$widths) - 1)
# Add second y-axis title
ia <- which(g2$layout$name == "ylab")
ax <- g2$grobs[[ia]]
# str(ax) # you can change features (size, colour etc for these -
# change rotation below
ax$rot <- 90
g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g <- gtable_add_grob(g, ax, unique(pp$t), length(g$widths) - 1)
# Add legend to the code
leg1 <- g1$grobs[[which(g1$layout$name == "guide-box")]]
leg2 <- g2$grobs[[which(g2$layout$name == "guide-box")]]
g$grobs[[which(g$layout$name == "guide-box")]] <-
gtable:::cbind_gtable(leg1, leg2, "first")
grid.draw(g)
Now that ggplot2 has secondary axis support this has become much much easier in many (but not all) cases. No grob manipulation needed.
Even though it is supposed to only allow for simple linear transformations of the same data, such as different measurement scales, we can manually rescale one of the variables first to at least get a lot more out of that property.
library(tidyverse)
max_stones <- max(d1$stones)
max_revenue <- max(d1$revenue)
d2 <- gather(d1, 'var', 'val', stones:revenue) %>%
mutate(val = if_else(var == 'revenue', as.double(val), val / (max_stones / max_revenue)))
ggplot(mapping = aes(clarity, val)) +
geom_bar(aes(fill = cut), filter(d2, var == 'revenue'), stat = 'identity') +
geom_point(data = filter(d2, var == 'stones'), col = 'red') +
facet_grid(~cut) +
scale_y_continuous(sec.axis = sec_axis(trans = ~ . * (max_stones / max_revenue),
name = 'number of stones'),
labels = dollar) +
theme(axis.text.x = element_text(angle = 90, hjust = 1),
axis.text.y = element_text(color = "#4B92DB"),
axis.text.y.right = element_text(color = "red"),
legend.position="bottom") +
ylab('revenue')
It also works nicely with facet_wrap:
Other complications, such as scales = 'free' and space = 'free' are also done easily. The only restriction is that the relationship between the two axes is equal for all facets.
EDIT: UPDATED TO GGPLOT 2.2.0
But ggplot2 now supports secondary y axes, so there is no need for grob manipulation. See #Axeman's solution.
facet_grid and facet_wrap plots generate different sets of names for plot panels and left axes. You can check the names using g1$layout where g1 <- ggplotGrob(p1), and p1 is drawn first with facet_grid(), then second with facet_wrap(). In particular, with facet_grid() the plot panels are all named "panel", whereas with facet_wrap() they have different names: "panel-1", "panel-2", and so forth. So commands like these:
pp <- c(subset(g1$layout, name == "panel", se = t:r))
g <- gtable_add_grob(g1, g2$grobs[which(g2$layout$name == "panel")], pp$t,
pp$l, pp$b, pp$l)
will fail with plots generated using facet_wrap. I would use regular expressions to select all names beginning with "panel". There are similar problems with "axis-l".
Also, your axis-tweaking commands worked for older versions of ggplot, but from version 2.1.0, the tick marks don't quite meet the right edge of the plot, and the tick marks and the tick mark labels are too close together.
Here is what I would do (drawing on code from here, which in turn draws on code from here and from the cowplot package).
# Packages
library(ggplot2)
library(gtable)
library(grid)
library(data.table)
library(scales)
# Data
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 = 1) +
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 = 1) +
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)
# Get the locations of the plot panels in g1.
pp <- c(subset(g1$layout, grepl("panel", g1$layout$name), se = t:r))
# Overlap panels for second plot on those of the first plot
g <- gtable_add_grob(g1, g2$grobs[grepl("panel", g1$layout$name)],
pp$t, pp$l, pp$b, pp$l)
# ggplot contains many labels that are themselves complex grob;
# usually a text grob surrounded by margins.
# When moving the grobs from, say, the left to the right of a plot,
# Make sure the margins and the justifications are swapped around.
# The function below does the swapping.
# Taken from the cowplot package:
# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R
hinvert_title_grob <- function(grob){
# Swap the widths
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]
# Fix the justification
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 axis title from g2
index <- which(g2$layout$name == "ylab-l") # Which grob contains the y axis title? EDIT HERE
ylab <- g2$grobs[[index]] # Extract that grob
ylab <- hinvert_title_grob(ylab) # Swap margins and fix justifications
# Put the transformed label on the right side of g1
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], max(pp$r))
g <- gtable_add_grob(g, ylab, max(pp$t), max(pp$r) + 1, max(pp$b), max(pp$r) + 1, clip = "off", name = "ylab-r")
# Get the y axis from g2 (axis line, tick marks, and tick mark labels)
index <- which(g2$layout$name == "axis-l-1-1") # Which grob. EDIT HERE
yaxis <- g2$grobs[[index]] # Extract the grob
# yaxis is a complex of grobs containing the axis line, the tick marks, and the tick mark labels.
# The relevant grobs are contained in axis$children:
# axis$children[[1]] contains the axis line;
# axis$children[[2]] contains the tick marks and tick mark labels.
# First, move the axis line to the left
# But not needed here
# yaxis$children[[1]]$x <- unit.c(unit(0, "npc"), unit(0, "npc"))
# Second, swap tick marks and tick mark labels
ticks <- yaxis$children[[2]]
ticks$widths <- rev(ticks$widths)
ticks$grobs <- rev(ticks$grobs)
# Third, move the tick marks
# Tick mark lengths can change.
# A function to get the original tick mark length
# Taken from the cowplot package:
# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R
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
# Fourth, swap margins and fix justifications for the tick mark labels
ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]])
# Fifth, put ticks back into yaxis
yaxis$children[[2]] <- ticks
# Put the transformed yaxis on the right side of g1
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], max(pp$r))
g <- gtable_add_grob(g, yaxis, max(pp$t), max(pp$r) + 1, max(pp$b), max(pp$r) + 1,
clip = "off", name = "axis-r")
# 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")
# Draw it
grid.newpage()
grid.draw(g)

Resources