Some time ago, I inquired about adding a secondary transformed x-axis in ggplot, and Nate Pope provided the excellent solution described at ggplot2: Adding secondary transformed x-axis on top of plot.
That solution worked great for me, and I returned to it hoping it would work for a new project. Unfortunately, the solution doesn't work correctly in the most recent version of ggplot2. Now, running the exact same code leads to a "clipping" of the axis title, as well as overlap of the tick marks and labels. Here is an example, with the problems highlighted in blue:
This example can be reproduced with the following code (this is an exact copy of Nate Pope's code that previously worked marvelously):
library(ggplot2)
library(gtable)
library(grid)
LakeLevels<-data.frame(Day=c(1:365),Elevation=sin(seq(0,2*pi,2*pi/364))*10+100)
## 'base' plot
p1 <- ggplot(data=LakeLevels) + geom_line(aes(x=Elevation,y=Day)) +
scale_x_continuous(name="Elevation (m)",limits=c(75,125)) +
ggtitle("stuff") +
theme(legend.position="none", plot.title=element_text(hjust=0.94, margin = margin(t = 20, b = -20)))
## plot with "transformed" axis
p2<-ggplot(data=LakeLevels)+geom_line(aes(x=Elevation, y=Day))+
scale_x_continuous(name="Elevation (ft)", limits=c(75,125),
breaks=c(90,101,120),
labels=round(c(90,101,120)*3.24084) ## labels convert to feet
)
## 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)
g <- gtable_add_grob(g1, g1$grobs[[which(g1$layout$name=="panel")]], pp$t, pp$l, pp$b, pp$l)
## steal axis from second plot and modify
ia <- which(g2$layout$name == "axis-b")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]
## switch position of ticks and labels
ax$heights <- rev(ax$heights)
ax$grobs <- rev(ax$grobs)
ax$grobs[[2]]$y <- ax$grobs[[2]]$y - unit(1, "npc") + unit(0.15, "cm")
## modify existing row to be tall enough for axis
g$heights[[2]] <- g$heights[g2$layout[ia,]$t]
## add new axis
g <- gtable_add_grob(g, ax, 2, 4, 2, 4)
## add new row for upper axis label
g <- gtable_add_rows(g, g2$heights[1], 1)
g <- gtable_add_grob(g, g2$grob[[6]], 2, 4, 2, 4)
# draw it
grid.draw(g)
Running the above code leads to two critical problems, which I am trying to resolve:
1) How to adjust the x-axis added to the top of the plot to fix the "clipping" and overlap issues?
2) How to include the ggtitle("stuff")
added to the first plot p1
in the final plot?
I've been trying to resolve these problems all afternoon, but cannot seem to solve them. Any help is much appreciated. Thanks!
Updated to ggplot2 v 2.2.1, but it is easier to use sec.axis
- see here
Original
Moving axes in ggplot2
became more complex from version 2.1.0. This solution draws on code from older solutions and from code in the cowplot
package.
With respect to your second issue, it was easier to construct a separate text grob for the "Stuff" title (rather than dealing with ggtitle
with its margins).
library(ggplot2) #v 2.2.1
library(gtable) #v 0.2.0
library(grid)
LakeLevels <- data.frame(Day = c(1:365), Elevation = sin(seq(0, 2*pi, 2 * pi/364)) * 10 + 100)
## 'base' plot
p1 <- ggplot(data = LakeLevels) +
geom_path(aes(x = Elevation, y = Day)) +
scale_x_continuous(name = "Elevation (m)", limits = c(75, 125)) +
theme_bw()
## plot with "transformed" axis
p2 <- ggplot(data = LakeLevels) +
geom_path(aes(x = Elevation, y = Day))+
scale_x_continuous(name = "Elevation (ft)", limits = c(75, 125),
breaks = c(80, 90, 100, 110, 120),
labels = round(c(80, 90, 100, 110, 120) * 3.28084)) + ## labels convert to feet
theme_bw()
## Get gtable
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
## Get the position of the plot panel in g1
pp <- c(subset(g1$layout, name == "panel", se = t:r))
# Title grobs have margins.
# The margins need to be swapped.
# Function to swap margins -
# taken from the cowplot package:
# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R
vinvert_title_grob <- function(grob) {
heights <- grob$heights
grob$heights[1] <- heights[3]
grob$heights[3] <- heights[1]
grob$vp[[1]]$layout$heights[1] <- heights[3]
grob$vp[[1]]$layout$heights[3] <- heights[1]
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$y <- unit(1, "npc") - grob$children[[1]]$y
grob
}
# Copy "Elevation (ft)" xlab from g2 and swap margins
index <- which(g2$layout$name == "xlab-b")
xlab <- g2$grobs[[index]]
xlab <- vinvert_title_grob(xlab)
# Put xlab at the top of g1
g1 <- gtable_add_rows(g1, g2$heights[g2$layout[index, ]$t], pp$t-1)
g1 <- gtable_add_grob(g1, xlab, pp$t, pp$l, pp$t, pp$r, clip = "off", name="topxlab")
# Get "feet" axis (axis line, tick marks and tick mark labels) from g2
index <- which(g2$layout$name == "axis-b")
xaxis <- g2$grobs[[index]]
# Move the axis line to the bottom (Not needed in your example)
xaxis$children[[1]]$y <- unit.c(unit(0, "npc"), unit(0, "npc"))
# Swap axis ticks and tick mark labels
ticks <- xaxis$children[[2]]
ticks$heights <- rev(ticks$heights)
ticks$grobs <- rev(ticks$grobs)
# Move tick marks
ticks$grobs[[2]]$y <- ticks$grobs[[2]]$y - unit(1, "npc") + unit(3, "pt")
# Sswap tick mark labels' margins
ticks$grobs[[1]] <- vinvert_title_grob(ticks$grobs[[1]])
# Put ticks and tick mark labels back into xaxis
xaxis$children[[2]] <- ticks
# Add axis to top of g1
g1 <- gtable_add_rows(g1, g2$heights[g2$layout[index, ]$t], pp$t)
g1 <- gtable_add_grob(g1, xaxis, pp$t+1, pp$l, pp$t+1, pp$r, clip = "off", name = "axis-t")
# Add "Stuff" title
titleGrob = textGrob("Stuff", x = 0.9, y = 0.95, gp = gpar(cex = 1.5, fontface = "bold"))
g1 <- gtable_add_grob(g1, titleGrob, pp$t+2, pp$l, pp$t+2, pp$r, name = "Title")
# Draw it
grid.newpage()
grid.draw(g1)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With