我需要在一个图表中绘制一个显示计数的柱状图和一个显示率的折线图,我可以分别做这两个,但当我把它们放在一起时,我的第一层(即geom_bar)的比例被第二层(即geom_line)重叠。

我可以将geom_line的轴向右移动吗?


当前回答

Kohske大约在3年前提供了解决这一挑战的技术骨干。在Stackoverflow [id: 18989001, 29235405, 21026598]的几个实例中已经讨论过这个主题及其解决方案的技术细节。因此,我将只提供一个特定的变化和一些解释性演练,使用上述解决方案。

让我们假设我们确实在组G1中有一些数据y1,而组G2中的一些数据y2以某种方式相关,例如范围/比例转换或添加了一些噪声。我们想把数据画在一张图上,左边是y1右边是y2。

  df <- data.frame(item=LETTERS[1:n],  y1=c(-0.8684, 4.2242, -0.3181, 0.5797, -0.4875), y2=c(-5.719, 205.184, 4.781, 41.952, 9.911 )) # made up!

> df
  item      y1         y2
1    A -0.8684 -19.154567
2    B  4.2242 219.092499
3    C -0.3181  18.849686
4    D  0.5797  46.945161
5    E -0.4875  -4.721973

如果我们现在把数据画在一起

ggplot(data=df, aes(label=item)) +
  theme_bw() + 
  geom_segment(aes(x='G1', xend='G2', y=y1, yend=y2), color='grey')+
  geom_text(aes(x='G1', y=y1), color='blue') +
  geom_text(aes(x='G2', y=y2), color='red') +
  theme(legend.position='none', panel.grid=element_blank())

它并没有很好地对齐,因为小尺度y1明显被大尺度y2折叠了。

这里应对挑战的技巧是在技术上根据第一个尺度y1绘制两个数据集,但根据二级轴报告第二个数据集,并使用标签显示原始尺度y2。

因此,我们构建了第一个辅助函数CalcFudgeAxis,它计算并收集要显示的新轴的特征。这个函数可以被修改成任意的形式(这个函数只是将y2映射到y1的范围上)。

CalcFudgeAxis = function( y1, y2=y1) {
  Cast2To1 = function(x) ((ylim1[2]-ylim1[1])/(ylim2[2]-ylim2[1])*x) # x gets mapped to range of ylim2
  ylim1 <- c(min(y1),max(y1))
  ylim2 <- c(min(y2),max(y2))    
  yf <- Cast2To1(y2)
  labelsyf <- pretty(y2)  
  return(list(
    yf=yf,
    labels=labelsyf,
    breaks=Cast2To1(labelsyf)
  ))
}

什么产生了一些:

> FudgeAxis <- CalcFudgeAxis( df$y1, df$y2 )

> FudgeAxis
$yf
[1] -0.4094344  4.6831656  0.4029175  1.0034664 -0.1009335

$labels
[1] -50   0  50 100 150 200 250

$breaks
[1] -1.068764  0.000000  1.068764  2.137529  3.206293  4.275058  5.343822


> cbind(df, FudgeAxis$yf)
  item      y1         y2 FudgeAxis$yf
1    A -0.8684 -19.154567   -0.4094344
2    B  4.2242 219.092499    4.6831656
3    C -0.3181  18.849686    0.4029175
4    D  0.5797  46.945161    1.0034664
5    E -0.4875  -4.721973   -0.1009335

现在我将Kohske的解决方案包装在第二个辅助函数PlotWithFudgeAxis中(我们将ggplot对象和新轴的辅助对象放入其中):

library(gtable)
library(grid)

PlotWithFudgeAxis = function( plot1, FudgeAxis) {
  # based on: https://rpubs.com/kohske/dual_axis_in_ggplot2
  plot2 <- plot1 + with(FudgeAxis, scale_y_continuous( breaks=breaks, labels=labels))

  #extract gtable
  g1<-ggplot_gtable(ggplot_build(plot1))
  g2<-ggplot_gtable(ggplot_build(plot2))

  #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)

  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)

  grid.draw(g)
}

现在可以将所有内容放在一起:下面的代码显示了建议的解决方案如何在日常环境中使用。plot调用现在不再绘制原始数据y2,而是一个克隆版本yf(保存在预先计算的辅助对象FudgeAxis中),它以y1的规模运行。然后使用Kohske的辅助函数PlotWithFudgeAxis操作原始ggplot对象,以添加第二个轴,保留y2的刻度。它的情节和被操纵的情节一样。

FudgeAxis <- CalcFudgeAxis( df$y1, df$y2 )

tmpPlot <- ggplot(data=df, aes(label=item)) +
      theme_bw() + 
      geom_segment(aes(x='G1', xend='G2', y=y1, yend=FudgeAxis$yf), color='grey')+
      geom_text(aes(x='G1', y=y1), color='blue') +
      geom_text(aes(x='G2', y=FudgeAxis$yf), color='red') +
      theme(legend.position='none', panel.grid=element_blank())

PlotWithFudgeAxis(tmpPlot, FudgeAxis)

现在它有两个轴,左边是y1右边是y2

Above solution is, to put it straight, a limited shaky hack. As it plays with the ggplot kernel it will throw some warnings that we exchange post-the-fact scales, etc. It has to be handled with care and may produce some undesired behaviour in another setting. As well one may need to fiddle around with the helper functions to get the layout as desired. The placement of the legend is such an issue (it would be placed between the panel and the new axis; this is why I droped it). The scaling / alignment of the 2 axis is as well a bit challenging: The code above works nicely when both scales contain the "0", else one axis gets shifted. So definetly with some opportunities to improve...

如果on想要保存图片,就必须将调用包装成设备打开/关闭:

png(...)
PlotWithFudgeAxis(tmpPlot, FudgeAxis)
dev.off()

其他回答

我承认并同意哈德利(和其他人)的观点,即单独的y量表“存在根本缺陷”。说到这里,我经常希望ggplot2有这个特性——特别是当数据是宽格式的,并且我想快速地可视化或检查数据时(即仅供个人使用)。

虽然tidyverse库可以很容易地将数据转换为长格式(这样facet_grid()就可以工作),但这个过程仍然不是简单的,如下所示:

library(tidyverse)
df.wide %>%
    # Select only the columns you need for the plot.
    select(date, column1, column2, column3) %>%
    # Create an id column – needed in the `gather()` function.
    mutate(id = n()) %>%
    # The `gather()` function converts to long-format. 
    # In which the `type` column will contain three factors (column1, column2, column3),
    # and the `value` column will contain the respective values.
    # All the while we retain the `id` and `date` columns.
    gather(type, value, -id, -date) %>%
    # Create the plot according to your specifications
    ggplot(aes(x = date, y = value)) +
        geom_line() +
        # Create a panel for each `type` (ie. column1, column2, column3).
        # If the types have different scales, you can use the `scales="free"` option.
        facet_grid(type~., scales = "free")

我们当然可以用R函数图来建立一个双y轴的图。

# pseudo dataset
df <- data.frame(x = seq(1, 1000, 1), y1 = sample.int(100, 1000, replace=T), y2 = sample(50, 1000, replace = T))

# plot first plot 
with(df, plot(y1 ~ x, col = "red"))

# set new plot
par(new = T) 

# plot second plot, but without axis
with(df, plot(y2 ~ x, type = "l", xaxt = "n", yaxt = "n", xlab = "", ylab = ""))

# define y-axis and put y-labs
axis(4)
with(df, mtext("y2", side = 4))

下面的文章帮助我将ggplot2生成的两个图合并到单行上:

一页上的多个图(ggplot2)由Cookbook for R

下面是代码在这种情况下的样子:

p1 <- 
  ggplot() + aes(mns)+ geom_histogram(aes(y=..density..), binwidth=0.01, colour="black", fill="white") + geom_vline(aes(xintercept=mean(mns, na.rm=T)), color="red", linetype="dashed", size=1) +  geom_density(alpha=.2)

p2 <- 
  ggplot() + aes(mns)+ geom_histogram( binwidth=0.01, colour="black", fill="white") + geom_vline(aes(xintercept=mean(mns, na.rm=T)), color="red", linetype="dashed", size=1)  

multiplot(p1,p2,cols=2)

常见的用例有双y轴,例如,显示每月温度和降水的气体图。这里是一个简单的解决方案,从威震天的解决方案中推广,允许你设置变量的下限为零:

示例数据:

climate <- tibble(
  Month = 1:12,
  Temp = c(-4,-4,0,5,11,15,16,15,11,6,1,-3),
  Precip = c(49,36,47,41,53,65,81,89,90,84,73,55)
  )

将以下两个值设置为接近数据限制的值(您可以使用这些值来调整图形的位置;坐标轴仍然是正确的):

ylim.prim <- c(0, 180)   # in this example, precipitation
ylim.sec <- c(-4, 18)    # in this example, temperature

下面根据这些极限进行必要的计算,并制作出图本身:

b <- diff(ylim.prim)/diff(ylim.sec)
a <- ylim.prim[1] - b*ylim.sec[1]) # there was a bug here

ggplot(climate, aes(Month, Precip)) +
  geom_col() +
  geom_line(aes(y = a + Temp*b), color = "red") +
  scale_y_continuous("Precipitation", sec.axis = sec_axis(~ (. - a)/b, name = "Temperature")) +
  scale_x_continuous("Month", breaks = 1:12) +
  ggtitle("Climatogram for Oslo (1961-1990)")  

如果你想确保红线对应右边的y轴,你可以在代码中添加一个主题句:

ggplot(climate, aes(Month, Precip)) +
  geom_col() +
  geom_line(aes(y = a + Temp*b), color = "red") +
  scale_y_continuous("Precipitation", sec.axis = sec_axis(~ (. - a)/b, name = "Temperature")) +
  scale_x_continuous("Month", breaks = 1:12) +
  theme(axis.line.y.right = element_line(color = "red"), 
        axis.ticks.y.right = element_line(color = "red"),
        axis.text.y.right = element_text(color = "red"), 
        axis.title.y.right = element_text(color = "red")
        ) +
  ggtitle("Climatogram for Oslo (1961-1990)")

右轴的颜色:

从ggplot2 2.2.0开始,您可以添加如下的辅助轴(取自ggplot2 2.2.0公告):

ggplot(mpg, aes(displ, hwy)) + 
  geom_point() + 
  scale_y_continuous(
    "mpg (US)", 
    sec.axis = sec_axis(~ . * 1.20, name = "mpg (UK)")
  )