ggplot2 2.1.0 hat meinen Code zerstört? Die sekundär transformierte Achse erscheint nun falsch

Question

Vor einiger Zeit erkundigte ich mich nach dem Hinzufügen einer sekundären transformierten X-Achse in ggplot, und Nate Pope lieferte die ausgezeichnete Lösung, die unter ggplot2: Adding secondary transformed x-axis on top of plot beschrieben wird.

Diese Lösung funktionierte gut für mich, und ich kehrte zu der Hoffnung zurück, dass es für ein neues Projekt funktionieren würde. Leider funktioniert die Lösung nicht korrekt in der neuesten Version von ggplot2. Jetzt führt der exakt gleiche Code zu einem "Clipping" des Achsentitels, sowie Überlappung der Teilstriche und Beschriftungen. Hier ist ein Beispiel, mit den Problemen in blau hervorgehoben:

Dieses Beispiel kann mit dem folgenden Code wiedergegeben werden (dies ist eine exakte Kopie von Nate Papst Code, der zuvor wunderbar gearbeitet):

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) 

den obigen Code Laufen führt zu zwei kritischen Problemen, die ich zu lösen versuchen:

1) Wie die x-Achse auf die Oberseite des p hinzugefügt einzustellen viel, um die "Clipping" und Überlappungsprobleme zu beheben?

2) Wie sind die ggtitle("stuff") mit dem ersten Grundstück p1 in dem letzten Plot hinzugefügt?

Ich habe versucht, diese Probleme den ganzen Nachmittag zu lösen, aber kann nicht scheinen, sie zu lösen. Jede Hilfe wird sehr geschätzt. Vielen Dank!

Answer 1

Nach einiger Überlegung habe ich bestätigt, dass das Problem # 1 von Änderungen an den letzten Versionen von ggplot2 herrührt, und ich habe auch eine temporäre Lösung gefunden - eine alte Version von ggplot2 installieren.

Installing older version of R package ggplot2 1.0.0 installieren Nach installierte ich ggplot2 1.0.0

packageurl <- "http://cran.r-project.org/src/contrib/Archive/ggplot2/ggplot2_1.0.0.tar.gz" 
install.packages(packageurl, repos=NULL, type="source") 

verwendet, die ich mit

prüft

packageDescription("ggplot2")$Version 

Dann wieder laufen den genauen Code gepostet oben, ich konnte ein Grundstück mit der zusätzlichen x-Achse korrekt angezeigt erzeugen:

Dies ist natürlich keine sehr befriedigende Antwort, aber es funktioniert zumindest bis jemand klüger als ich erklären kann, warum dieser Ansatz in den letzten Versionen von ggplot2 nicht funktioniert. :)

Also Problem 1 von oben wurde behoben. Ich habe immer noch das Problem Nr. 2 von oben nicht gelöst, daher würde ich mich über jeden Hinweis freuen.

Answer 2

Aktualisiert zu ggplot2 v 2.2.1, aber es ist einfacher, sec.axis zu verwenden - here

Original-

Bewegte Achsen in ggplot2 komplexer wurden von Version 2.1.0 sehen. Diese Lösung basiert auf Code älterer Lösungen und auf Code im Paket cowplot.

In Bezug auf Ihr zweites Problem, war es einfacher, einen separaten Text grob für den Titel "Stuff" zu konstruieren (anstatt ggtitle mit seinen Rändern zu behandeln).

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)