条形图和线图的ggplot2叠加

Question

我从本网站上的某个人那里逐行复制了有关如何用两个 y 轴覆盖两个图的代码。但是，该示例使用了两个线图，但我想要覆盖一个线图和一个条形图。我似乎根本无法获得覆盖，它只是绘制线图。请帮忙。谢谢。

    library(ggplot2)
library(gtable)
library(grid)
require(ggplot2)
df1 <- data.frame(frax=c(0,30,60,114),solvb=c(0,0,100,100))
df2 <-data.frame(
  type = factor(c("mascot","mstat"), levels=c("mascot","mstat")), frax = c(30,35,40,45,50,55), phos=c(542,413,233,500,600,650))

p1<-ggplot(df2,aes(x=frax, y=phos,fill=type)) + geom_bar(stat="identity",position="dodge") + scale_x_continuous("fractions",breaks=seq(1,115,2)) + scale_y_continuous("Phospho hits",breaks=seq(0,1400,250))
p2<-ggplot(df1,aes(x=frax,y=solvb)) + geom_line(colour="blue")


#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
alab<-g2$grobs[[which(g2$layout$name=="ylab")]]
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_cols(g, g2$widths[g2$layout[ia,]$l],
                   length(g$widths)-1)
g<-gtable_add_grob(g,ax,pp$t,length(g$widths) - 2,pp$b)
g<-gtable_add_grob(g,alab,pp$t,length(g$widths) - 1,pp$b)

grid.draw(g)

我希望输出看起来与此完全相同（或非常相似）： 但是，我希望条形图“躲避”

Answer 1

最近发现，从ggplot2的2.2.0版本开始，可以添加secondary axis。一些演示：here 或here；有些人已经用这种方法回答了问题：here、here 或 here。关于添加第二个 OY 轴的有趣讨论here。

主要思想是需要对第二个 OY 轴应用变换。在下面的示例中，变换因子是每个 OY 轴的最大值之间的比率。

require(ggplot2)

my_factor <- 650/100
ggplot() +
  geom_bar(data = df2, 
           aes(x = frax, y = phos, fill = type), 
           stat = "identity", 
           position = "dodge") +
  geom_line(data = df1,
            # Apply the factor on values appearing on second OY axis (multiplication)
            aes(x = frax, y = solvb * my_factor), 
            colour = "blue") +
  # add second OY axis; note the transformation back (division)
  scale_y_continuous(sec.axis = sec_axis(trans = ~ . / my_factor, 
                                         name = "% Solvent B")) +
  # final adjustments
  labs(x = "Fractions",
       y = "Phospho hits",
       fill = "") +
  theme_bw()

Answer 2

这可以满足您的大部分需求：向内指向的刻度线、来自两个绘图的组合图例、两个绘图的重叠以及将一个绘图的 y 轴移动到绘图的右侧。

library(ggplot2) # version 2.2.1
library(gtable)  # version 0.2.0
library(grid)

# Your data
df1 <- data.frame(frax = c(16,30,60,64), solvb = c(0,0,100,100))
df2 <- data.frame(type = factor(c("mascot","mstat"), levels = c("mascot","mstat")), 
                 frax = c(30,35,40,45,50,55), phos = c(542,413,233,500,600,650))

# Base plots
p1 <- ggplot(df2, aes(x = frax, y = phos, fill = type)) + 
   geom_bar(stat = "identity", position = "dodge") + 
   scale_x_continuous("fractions", expand = c(0,0), limits = c(16, 64), 
          breaks = seq(20,60,5), labels = seq(20, 60, 5)) + 
   scale_y_continuous("Phospho hits", breaks = seq(0,1400,250), expand = c(0,0), 
          limits = c(0, 700)) +
   scale_fill_discrete("") +
   theme_bw() +
   theme(panel.grid = element_blank(),
         legend.key = element_rect(colour = "white"),
         axis.ticks.length = unit(-1, "mm"),  #tick marks inside the panel
         axis.text.x = element_text(margin = margin(t = 7, b = 0)),   # Adjust the text margins
         axis.text.y = element_text(margin = margin(l = 0, r = 7)))

p2 <- ggplot(df1, aes(x = frax, y = solvb)) + 
   geom_line(aes(linetype = "LC Gradient"), colour = "blue", size = .75) +
   scale_x_continuous("fractions", expand = c(0,0), limits = c(16, 64)) + 
   scale_y_continuous("% Solvent B") +
   scale_linetype_manual("", values="longdash") +
   theme_bw() +
   theme(panel.background = element_rect(fill = "transparent"), 
         panel.grid = element_blank(),
         axis.ticks.length = unit(-1, "mm"),
         axis.text.x = element_text(margin = margin(t = 7, b = 0)),
         axis.text.y = element_text(margin = margin(l = 0, r = 7)),
         legend.key.width = unit(1.5, "cm"),   # Widen the key 
         legend.key = element_rect(colour = "white"))


# Extract gtables
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)

# Get their legends
leg1 = g1$grobs[[which(g1$layout$name == "guide-box")]]
leg2 = g2$grobs[[which(g2$layout$name == "guide-box")]]

# Join them into one legend
leg = cbind(leg1, leg2, size = "first")  # leg to be positioned later

# Drop the legends from the two gtables
pos = subset(g1$layout, grepl("guide-box", name), l)
g1 = g1[, -pos$l]
g2 = g2[, -pos$l]


## Code taken from http://stackoverflow.com/questions/36754891/ggplot2-adding-secondary-y-axis-on-top-of-a-plot/36759348#36759348
#  to move y axis to right hand side

# Get the location of the plot panel in g1.
# These are used later when transformed elements of g2 are put back into g1
pp <- c(subset(g1$layout, name == "panel", se = t:r))

# Overlap panel for second plot on that of the first plot
g1 <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], 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?
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
g1 <- gtable_add_cols(g1, g2$widths[g2$layout[index, ]$l], pp$r)
g1 <- gtable_add_grob(g1, ylab, pp$t, pp$r + 1, pp$b, 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")  # Which grob
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
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
ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") + unit(-1, "mm")

# 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
g1 <- gtable_add_cols(g1, g2$widths[g2$layout[index, ]$l], pp$r)
g1 <- gtable_add_grob(g1, yaxis, pp$t, pp$r + 1, pp$b, pp$r + 1, clip = "off", name = "axis-r")

# Draw it
grid.newpage()
grid.draw(g1)

# Add the legend in a viewport
vp = viewport(x = 0.3, y = 0.92, height = .2, width = .2)
pushViewport(vp)
grid.draw(leg)
upViewport()

g = grid.grab()
grid.newpage()
grid.draw(g)