替换gtable中的ggplot元素:标签和网格线

时间:2015-01-03 12:04:42

标签: r ggplot2 gtable r-grid

我正在学习使用ggplot操纵gtable个对象。 [这是我提出的相关问题:dismantling a ggplot with grid and gtable]

目前的问题是:

  1. 如何从一个gtable中取出各种轴元素并将它们放入另一个gtable中以替换现有元素?,特别是:替换垂直网格线(和相应的刻度线)。
  2. 下面是一些代码和数据。

    # Data
    df <- structure(list(Year = c(1950, 2013, 1950, 2013), Country = structure(c(1L, 
    1L, 2L, 2L), .Label = c("France", "United States"), class = "factor"), 
    Category = c("Hourly minimum wage", "Hourly minimum wage", 
    "Hourly minimum wage", "Hourly minimum wage"), value = c(2.14, 
    9.43, 3.84, 7.25), variable = c("France (2013 euros)", 
    "France (2013 euros)", "United States (2013 dollars)", "United States (2013 dollars)"
    ), Unit = c("2013 euros", "2013 euros", "2013 dollars", "2013 dollars"
    )), .Names = c("Year", "Country", "Category", "value", "variable", 
    "Unit"), row.names = c(NA, 4L), class = "data.frame")
    
    # Plot data with ggplot
    library(ggplot2)
    p1 <- ggplot(data = df, aes(x = Year, y = value, group = variable, colour = variable, shape = variable)) + 
    geom_line(size = 2, show_guide = FALSE) + 
    geom_point(size = 4, show_guide = FALSE) +
    theme(panel.grid.major.x = element_line(size = 1, colour = "darkgreen"), 
          panel.grid.minor.x = element_line(size = 1, colour = "darkgreen", linetype = "dotted")) +
    theme(text = element_text(size = 20, colour = "darkgreen")) +
    theme(axis.text = element_text(size = 20, colour = "darkgreen"))
    

    这是p1:

    enter image description here

    p2 <- ggplot(data = df, aes(x = Year, y = value, group = variable, colour = variable, shape = variable)) + 
    geom_line(size = 2, show_guide = FALSE) + 
    geom_point(size = 4, show_guide = FALSE) +
    theme(panel.grid.major.x = element_line(size = 1, colour = "darkred"), 
          panel.grid.minor.x = element_line(size = 1, colour = "darkred", linetype = "dotted")) +
    theme(text = element_text(size = 20, colour = "darkred")) +
    theme(axis.text = element_text(size = 20, colour = "darkred"))
    

    这是p2:

    enter image description here

    # replace the bottom axis of p1 with that of p2
    library(gtable)
    g1 <- ggplot_gtable(ggplot_build(p1))
    g2 <- ggplot_gtable(ggplot_build(p2))
    
    # function to remove selected elements from gtables, keeping widths
    gtable_grob_remove <- function (g, what = "guide-box") {
        require(gtable)
        matches <- c(grepl(pattern = what, g$layout$name))
        g$layout <- g$layout[!matches, , drop = FALSE]
        g$grobs <- g$grobs[!matches]
        return(g)
    }
    
    # replace "axis-b"
    g <- g1
    pos <- c(subset(g$layout, name == "axis-b", se = t:r))
    g <- gtable_grob_remove(g, what = "axis-b")
    g <- gtable_add_grob(g, g2$grobs[[which(g2$layout$name == "axis-b")]], 
        pos$t, pos$l, pos$b, pos$r, , name = "axis-b")
    
    # replace "xlab"
    pos <- c(subset(g$layout, name == "xlab", se = t:r))
    g <- gtable_grob_remove(g, what = "xlab")
    g <- gtable_add_grob(g, g2$grobs[[which(g2$layout$name == "xlab")]], 
        pos$t, pos$l, pos$b, pos$r, , name = "xlab")
    
    grid.newpage()
    grid.draw(g)
    

    这是带有一些p2元素的p1:

    enter image description here

    g1为绿色,g2为红色,我希望红色底轴标签和垂直网格线代替绿色。

    我已成功识别轴标签和轴标题,但我仍在寻找垂直网格线(以及轴标记和轴水平线!)。我想他们在panel内,但如何访问它们并改变它们?

    在之前的评论中,baptiste建议names(ggplotGrob(p2)[["grobs"]][[4]][["children"]])作为识别不同元素的方法。这将返回:

    names(ggplotGrob(p2)[["grobs"]][[4]][["children"]])
    [1] "grill.gTree.843"           "GRID.polyline.828"        
    [3] "geom_point.points.830"     "panel.border.zeroGrob.831"
    

    但是,我不知道怎么从这里拿走它。另外,附加的数字,例如, .843随着每个会话而变化,所以我想找到一种不对这些数字进行硬编码的方法。谢谢你的建议!

1 个答案:

答案 0 :(得分:5)

根据其他答案,考虑一下,

# locate the children
grill1 <- grepl("grill", 
              names(g1[["grobs"]][[4]][["children"]]))
grill2 <- grepl("grill", 
                names(g2[["grobs"]][[4]][["children"]]))

# swap the kids, the parents won't notice
g1[["grobs"]][[4]][["children"]][grill1] <- 
  g2[["grobs"]][[4]][["children"]][grill2]


grid.newpage()
grid.draw(g1)

enter image description here