在条形图上添加第二个 y 轴和线

Question

以下是我的数据

df <- data.frame(Lab = c("Queen II", "MMH", "Berea", "Maluti", "Motebang"),
             Expected = c(13200, 5280, 5280, 2640, 5280),
             Actual = c(8759, 761, 2263, 2210, 6100),
             utili_pct = c(66.35, 14.41, 42.86, 83.71, 115.53))

我试图绘制一个在图表上包含一条线的条形聊天。

第一步

# I Converted numeric variable "Actual" to a factor 
df$Actualx <- as.factor(df$Actual)

这样我就可以绘制一个包含两个因素变量与一个数字变量的图表 所以我整理数据并以这种方式运行绘图，但轴刻度变得没有顺序。

tidy_Data = df %>% gather(key, value, Actualx, Expected)

ggplot(tidy_Data, aes(x=Lab, y=value, fill=key)) +
         geom_bar(stat = "identity", position = position_dodge(0.8)) `

此外， 我试图添加一条线 utili_ptc 和第二个轴，但比例让我很难过， 该线与条不对齐。

ggplot(tidy_Data, aes(x=Lab, y=value, fill=key)) +
   geom_bar(stat = "identity", position = position_dodge(0.8)) + 
   geom_line(aes(x=Lab, y=utili_pct), color = "green", group = 1)

Answer 1

这里有一篇关于为什么不赞成使用第二个 y 轴的帖子

ggplot with 2 y axes on each side and different scales

为了回答您的具体问题，我进行了快速搜索并找到了这篇文章并用它构建了您的图表。看看能不能看懂

https://rpubs.com/kohske/dual_axis_in_ggplot2

  library(ggplot2)
  library(gtable)
  library(grid)

  grid.newpage()

  # two plots
  p1 <- ggplot(tidy_Data, aes(x=Lab, y=value, fill=key)) +
        geom_bar(stat = "identity", position = position_dodge(0.8)) +
        theme(legend.position = 'top')

  p2 <- ggplot(tidy_Data, aes(x = 1:10, y = utili_pct)) + geom_line() + 
        theme_bw() +
        theme(panel.background = element_rect(fill = NA))

  g1 <- ggplot_gtable(ggplot_build(p1))
  g2 <- ggplot_gtable(ggplot_build(p2))            

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

 # draw it
 grid.draw(g)

Answer 2

非常感谢您的指导。我终于能够使用您的代码按照我想要的方式绘制图表了。

library("tidyverse")

library("ggplot2")

library("gtable")

library("grid")

df <- data.frame(Lab = c("Queen II", "MMH", "Berea", "Maluti", "Motebang"), Actual = c(8759, 761, 2263, 2210, 5100), utili_pct = c(66.35, 14.41, 42.86, 83.71, 96.59), Expected = c(13200, 5280, 5280, 2640, 5280),stringsAsFactors = F)

整理数据

tidy_Data <- df%>% gather(key,value, Actual, Expected)

grid.newpage()

两个地块

p1 <- ggplot(tidy_Data, aes(x=Lab, y=value, fill=key)) + geom_bar(stat = "identity", position = position_dodge(0.8)) + theme(legend.position = "bottom")

p2 <- ggplot(df, aes(x=1:5, y=utili_pct)) + geom_line() + ylim(10,100) + theme_bw() + theme(panel.background = element_rect(fill = NA))

提取 gtable

g1 <- ggplot_gtable(ggplot_build(p1)) g2 <- ggplot_gtable(ggplot_build(p2))

将第二个图的面板与第一个图的面板重叠

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)