ggplot2 2.1.0打破了我的代码?二次转换轴现在显示不正确 [英] ggplot2 2.1.0 broke my code? Secondary transformed axis now appears incorrectly

查看:184
本文介绍了ggplot2 2.1.0打破了我的代码?二次转换轴现在显示不正确的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

前一段时间,我询问在ggplot中添加二次变换的x轴,Nate Pope提供了



这个例子可以用下面的代码复制(这是Nate Pope的代码的精确副本,以前工作得非常好):

  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)+
主题(legend.position =none,plot.title = element_text(hjust = 0.94,margin = margin(t = 20,b = -20)))

##以 (x =高程,y =日))+
s(数据= LakeLevels)+ geom_line(aes cale_x_continuous(name =Elevation(ft),limits = c(75,125),
breaks = c(90,101,120),
labels = round(c(90,101,120)* 3.24084)##标签转换为脚


##提取gtable
g1< - ggplot_gtable(ggplot_build(p1))
g2< - ggplot_gtable(ggplot_build(p2))

##与第一个图的面板重叠第二个图的面板
p <-c(子集(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,
$

g < - gtable_add_grob(g1,g1 $ grobs [[which(g1 $ layout $ name ==panel)]],pp $ t,pp $ l, pp $ b,pp $ l)

##从第二个绘图中获取轴并修改
ia< - 其中(g2 $ layout $ name ==axis-b)
ga < - g2 $ grobs [[ia]]
ax< - ga $ children [[2]]

##标记和标记的切换位置
ax $ heights< - rev(ax $ heights)
ax $ grobs< - rev(ax $ grobs)
ax $ grobs [[2]] $ y < - ax $ grobs [[2]] $ y - 单位(1,npc)+单位(0.15,cm)

##将现有行修改为轴高
g $ heights [[2]] < - g $ heights [g2 $ layout [ia,] $ t]

##添加新轴
g < - gtable_add_grob( g,ax,2,4,2,4)

##为上轴标签添加新行
g < - gtable_add_rows(g,g2 $ heights [1],1)
g < - gtable_add_grob(g,g2 $ grob [[6]],2,4,2,4)

#绘制
grid.draw(g)

运行上面的代码会导致两个关键问题,我试图解决:



1)如何调整x轴添加到图的顶部以修复裁剪和重叠问题?

2)如何将 ggtitle(stuff)添加到第一个图 p1 在最后的阴谋吗?



我一直试图解决这些问题整个下午,但似乎无法解决它们。任何帮助深表感谢。感谢!

解决方案

更新为ggplot2 v 2.2.1,但更易于使用 sec.axis - 请参阅


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)

这篇关于ggplot2 2.1.0打破了我的代码?二次转换轴现在显示不正确的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆