在ggplot2中将facet标签更改为数学公式

Question

我想知道如何将facet标签更改为数学公式ggplot2.

d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +
  xlim(0, 2) + stat_binhex(na.rm = TRUE) + opts(aspect.ratio = 1)
d + facet_wrap(~ color, ncol = 4)

例如,我想将facet标签从Dto 更改为Y[1],其中1是下标.在此先感谢您的帮助.

我找到了这个答案,但它对我不起作用.我正在使用R 2.15.1和ggplot2 0.9.1.

Answer 1

你可以编辑gtable中的grobs,

ggplot(diamonds, aes(carat, price, fill = ..density..)) +
  xlim(0, 2) + stat_binhex(na.rm = TRUE) + facet_wrap(~ color, ncol = 4)


for(ii in 1:7)
grid.gedit(gPath(paste0("strip_t-", ii), "strip.text"), 
           grep=TRUE, label=bquote(gamma[.(ii)]))

或者,如果你想保存一个grob,

g <- ggplotGrob(d)
gg <- g$grobs

strips <- grep("strip_t", names(gg))
for(ii in strips)
  gg[[ii]] <- editGrob(getGrob(gg[[ii]], "strip.text", 
                               grep=TRUE, global=TRUE), 
                       label=bquote(gamma[.(ii)]))

g$grobs <- gg

使用ggsave会需要额外的(丑陋)工作,因为必须愚弄ggplot类的测试...我认为pdf() ; grid.draw(g); dev.off()明确调用会更容易.

罗兰编辑:

我做了一个小修正并将其包裹在一个函数中:

facet_wrap_labeller <- function(gg.plot,labels=NULL) {
  #works with R 3.0.1 and ggplot2 0.9.3.1
  require(gridExtra)

  g <- ggplotGrob(gg.plot)
  gg <- g$grobs      
  strips <- grep("strip_t", names(gg))

  for(ii in seq_along(labels))  {
    modgrob <- getGrob(gg[[strips[ii]]], "strip.text", 
                       grep=TRUE, global=TRUE)
    gg[[strips[ii]]]$children[[modgrob$name]] <- editGrob(modgrob,label=labels[ii])
  }

  g$grobs <- gg
  class(g) = c("arrange", "ggplot",class(g)) 
  g
}

这样可以很好地打印,甚至ggsave可以使用.

Answer 2

也许有人在某些时候改变了编辑Grob函数的名称.(编辑:大约8个月前它被@hadley删除.) 没有geditGrob,只是editGrob来自pkg:grid似乎工作:

 d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +
              xlim(0, 2) + stat_binhex(na.rm = TRUE) + opts(aspect.ratio = 1)

 #Note: changes in ggplot2 functions cause this to fail from the very beginning now.
 # Frank Harrell's answer this year suggests `facet_warp` now accepts `labeller`


 d <- d + facet_wrap(~ color, ncol = 4)
 grob <- ggplotGrob(d)
 strip_elem <- grid.ls(getGrob(grob, "strip.text.x", grep=TRUE, global=TRUE))$name
#strip.text.x.text.1535
#strip.text.x.text.1541
#strip.text.x.text.1547
#strip.text.x.text.1553
#strip.text.x.text.1559
#strip.text.x.text.1565
#strip.text.x.text.1571
grob <- editGrob(grob, strip_elem[1], label=expression(Y[1]))
grid.draw(grob)

Answer 3

刚刚从roland和baptiste中发现了这个非常有用的函数,但是需要一个稍微不同的用例,其中原始的包装头应该由函数转换而不是作为固定值提供.我发布了原始函数的略微修改版本,以防它对其他人有用.它允许对包装条使用命名(固定值)表达式,以及使用自定义函数和ggplot2已为facet_grid labeller参数提供的函数(例如label_parsed和label_bquote).

facet_wrap_labeller <- function(gg.plot, labels = NULL, labeller = label_value) {
  #works with R 3.1.2 and ggplot2 1.0.1
  require(gridExtra)

  # old labels
  g <- ggplotGrob(gg.plot)
  gg <- g$grobs      
  strips <- grep("strip_t", names(gg))
  modgrobs <- lapply(strips, function(i) {
    getGrob(gg[[i]], "strip.text", grep=TRUE, global=TRUE)
  })
  old_labels <- sapply(modgrobs, function(i) i$label)

  # find new labels
  if (is.null(labels)) # no labels given, use labeller function
    new_labels <- labeller(names(gg.plot$facet$facets), old_labels)
  else if (is.null(names(labels))) # unnamed list of labels, take them in order
    new_labels <- as.list(labels)
  else { # named list of labels, go by name where provided, otherwise keep old
    new_labels <- sapply(as.list(old_labels), function(i) {
      if (!is.null(labels[[i]])) labels[[i]] else i
    })
  }

  # replace labels
  for(i in 1:length(strips))  {
    gg[[strips[i]]]$children[[modgrobs[[i]]$name]] <- 
       editGrob(modgrobs[[i]], label=new_labels[[i]])
  }

  g$grobs <- gg
  class(g) = c("arrange", "ggplot",class(g))
  return(g) 
}

更新/警告

对于较新版本的gridExtra程序包Error: No layers in plot,运行此函数时会出现错误,因为arrange不再存在gridExtra,R会尝试将其解释为ggplot.您可以通过(重新)引入该类的print函数来解决此问题arrange:

print.arrange <- function(x){
    grid::grid.draw(x)
}

这应该允许绘制图,你可以使用ggsave()如下:ggsave("test.pdf", plot = facet_wrap_labeller(p, labeller = label_parsed))

例子

一些用例示例:

# artificial data frame
data <- data.frame(x=runif(16), y=runif(16), panel = rep(c("alpha", "beta", "gamma","delta"), 4))
p <- ggplot(data, aes(x,y)) + geom_point() + facet_wrap(~panel)

# no changes, wrap panel headers stay the same
facet_wrap_labeller(p) 

# replace each panel title statically
facet_wrap_labeller(p, labels = expression(alpha^1, beta^1, gamma^1, delta^1)) 

# only alpha and delta are replaced
facet_wrap_labeller(p, labels = expression(alpha = alpha^2, delta = delta^2)) 

# parse original labels
facet_wrap_labeller(p, labeller = label_parsed) 

# use original labels but modifying them via bquote
facet_wrap_labeller(p, labeller = label_bquote(.(x)^3)) 

# custom function (e.g. for latex to expression conversion)
library(latex2exp)
facet_wrap_labeller(p, labeller = function(var, val) { 
  lapply(paste0("$\\sum\\", val, "$"), latex2exp)
}) 

Answer 4

从ggplot22.1.0版labeller开始已针对实施facet_wrap。