如何使用ggplot2动态包装facet标签

Question

我正在寻找一种方法来动态地将条带标签文本包装在一个facet_wrap或facet_grid调用中.我找到了一种方法来实现这一目的strwrap,但是我需要指定一个width输出才能按需运行.通常预先不知道小平面的数量,因此该方法需要我width基于数据集和绘图大小迭代地调整参数.是否可以动态指定包装函数的宽度,或者是否有其他选项可用于标记可以更好地工作的方面？

library(ggplot2)
df = expand.grid(group=paste(c("Very Very Very Long Group Name "), 1:9),
                 x=rnorm(5), y=rnorm(5), stringsAsFactors=FALSE)

df$groupwrap = unlist(lapply(strwrap(df$group, width=30, simplify=FALSE), paste, 
                             collapse="\n"))
p = ggplot(df) +
  geom_point(aes(x=x, y=y)) +
  facet_wrap(~groupwrap)

更新:基于@baptiste和@thunk提供的指导,我想出了下面的选项.目前,它仅适用于指定的字体系列和大小,但理想情况下,应该也可以使用默认theme设置.也许有ggplot2经验的人有一些改进的建议.

library('grid')
grobs <- ggplotGrob(p)

sum = sum(sapply(grobs$width, function(x) convertWidth(x, "in")))
panels_width = par("din")[1] - sum  # inches

df$group = as.factor(df$group)
npanels = nlevels(df$group)
if (class(p$facet)[1] == "wrap") {
  cols = n2mfrow(npanels)[1]
} else {
  cols = npanels
}

ps = 12
family = "sans"
pad = 0.01  # inches
panel_width = panels_width / cols
char_width = strwidth(levels(df$group)[
  which.max(nchar(levels(df$group)))], units="inches", cex=ps / par("ps"), 
                      family=family) / max(nchar(levels(df$group)))
width = floor((panel_width - pad)/ char_width)  # characters

df$groupwrap = unlist(lapply(strwrap(df$group, width=width, simplify=FALSE), 
                             paste, collapse="\n"))
ggplot(df) +
  geom_point(aes(x=x, y=y)) +
  facet_wrap(~groupwrap) +
  theme(strip.text.x=element_text(size=ps, family=family))

Answer 1

自从这个问题发布以来,label_wrap_gen()带有ggplot2(> = 1.0.0,我认为)的新函数处理得很好:

facet_wrap(~groupwrap, labeller = labeller(groupwrap = label_wrap_gen(10)))

请注意,您必须指定一个宽度才能工作.

对于较旧的ggplot2版本:

facet_wrap(~groupwrap, labeller = label_wrap_gen())

Answer 2

感谢@baptiste和@thunk的指导,我创建了下面的函数,这似乎可以很好地自动包装facet标签.不过,欢迎提出改进建议.

strwrap_strip_text = function(p, pad=0.05) { 
  # get facet font attributes
  th = theme_get()
  if (length(p$theme) > 0L)
    th = th + p$theme

  require("grid")
  grobs <- ggplotGrob(p)

  # wrap strip x text
  if ((class(p$facet)[1] == "grid" && !is.null(names(p$facet$cols))) ||
        class(p$facet)[1] == "wrap")
  {
    ps = calc_element("strip.text.x", th)[["size"]]
    family = calc_element("strip.text.x", th)[["family"]]
    face = calc_element("strip.text.x", th)[["face"]]

    if (class(p$facet)[1] == "wrap") {
      nm = names(p$facet$facets)
    } else {
      nm = names(p$facet$cols)
    }

    # get number of facet columns
    levs = levels(factor(p$data[[nm]]))
    npanels = length(levs)
    if (class(p$facet)[1] == "wrap") {
      cols = n2mfrow(npanels)[1]
    } else {
      cols = npanels
    }

    # get plot width
    sum = sum(sapply(grobs$width, function(x) convertWidth(x, "in")))
    panels_width = par("din")[1] - sum  # inches
    # determine strwrap width
    panel_width = panels_width / cols
    mx_ind = which.max(nchar(levs))
    char_width = strwidth(levs[mx_ind], units="inches", cex=ps / par("ps"), 
                          family=family, font=gpar(fontface=face)$font) / 
      nchar(levs[mx_ind])
    width = floor((panel_width - pad)/ char_width)  # characters

    # wrap facet text
    p$data[[nm]] = unlist(lapply(strwrap(p$data[[nm]], width=width, 
                                         simplify=FALSE), paste, collapse="\n"))
  }

  if (class(p$facet)[1] == "grid" && !is.null(names(p$facet$rows))) {  
    ps = calc_element("strip.text.y", th)[["size"]]
    family = calc_element("strip.text.y", th)[["family"]]
    face = calc_element("strip.text.y", th)[["face"]]

    nm = names(p$facet$rows)

    # get number of facet columns
    levs = levels(factor(p$data[[nm]]))
    rows = length(levs)

    # get plot height
    sum = sum(sapply(grobs$height, function(x) convertWidth(x, "in")))
    panels_height = par("din")[2] - sum  # inches
    # determine strwrap width
    panels_height = panels_height / rows
    mx_ind = which.max(nchar(levs))
    char_height = strwidth(levs[mx_ind], units="inches", cex=ps / par("ps"), 
                           family=family, font=gpar(fontface=face)$font) / 
      nchar(levs[mx_ind])
    width = floor((panels_height - pad)/ char_height)  # characters

    # wrap facet text
    p$data[[nm]] = unlist(lapply(strwrap(p$data[[nm]], width=width, 
                                         simplify=FALSE), paste, collapse="\n"))
  }

  invisible(p)
}

要使用该功能,请将其称为代替print.

library(ggplot2)
df = expand.grid(group=paste(c("Very Very Very Long Group Name "), 1:4),
                 group1=paste(c("Very Very Very Long Group Name "), 5:8),
                 x=rnorm(5), y=rnorm(5), stringsAsFactors=FALSE)

p = ggplot(df) +
  geom_point(aes(x=x, y=y)) +
  facet_grid(group1~group)
strwrap_strip_text(p)