ggplot2:将样本大小信息添加到x轴刻度标签

21

这个问题与创建自定义geom以计算摘要统计信息并将其显示在绘图区域之外有关。 (注意:所有函数均已简化;没有针对正确对象类型、NA等的错误检查。)

在基本的R环境中,创建一个生成带有分组变量每个水平下方示例大小的条形图函数相当容易:您可以使用mtext()函数添加样本大小信息:

stripchart_w_n_ver1 <- function(data, x.var, y.var) {
    x <- factor(data[, x.var])
    y <- data[, y.var]
# Need to call plot.default() instead of plot because 
# plot() produces boxplots when x is a factor.
    plot.default(x, y, xaxt = "n",  xlab = x.var, ylab = y.var)
    levels.x <- levels(x)
    x.ticks <- 1:length(levels(x))
    axis(1, at = x.ticks, labels = levels.x)
    n <- sapply(split(y, x), length)
    mtext(paste0("N=", n), side = 1, line = 2, at = x.ticks)
}

stripchart_w_n_ver1(mtcars, "cyl", "mpg")

或者你可以使用axis()函数将样本大小信息添加到x轴刻度标签中:

stripchart_w_n_ver2 <- function(data, x.var, y.var) {
    x <- factor(data[, x.var])
    y <- data[, y.var]
# Need to set the second element of mgp to 1.5 
# to allow room for two lines for the x-axis tick labels.
    o.par <- par(mgp = c(3, 1.5, 0))
    on.exit(par(o.par))
# Need to call plot.default() instead of plot because 
# plot() produces boxplots when x is a factor.
    plot.default(x, y, xaxt = "n", xlab = x.var, ylab = y.var)
    n <- sapply(split(y, x), length)
    levels.x <- levels(x)
    axis(1, at = 1:length(levels.x), labels = paste0(levels.x, "\nN=", n))
}

stripchart_w_n_ver2(mtcars, "cyl", "mpg")

使用axis()的示例

在基础R中,这是一项非常容易的任务,但在ggplot2中却异常复杂,因为很难获取用于生成图形的数据。虽然存在与axis()(例如scale_x_discrete等)等效的函数,但没有与mtext()相当的函数,它可以让你轻松地将文本放置在指定坐标的边距内。

我尝试使用内置的stat_summary()函数来计算样本大小(即fun.y = "length"),然后将该信息放置在x轴刻度标签上,但据我所知,您无法提取样本大小,然后通过函数scale_x_discrete()将它们添加到x轴刻度标签中,您必须告诉stat_summary()要使用哪个几何形状。您可以设置geom="text",但是然后您必须提供标签,而重点是标签应该是样本大小的值,这是stat_summary()正在计算的内容,但您无法获取它(并且您还必须指定要放置文本的位置,而且在哪里放置它以使其直接位于x轴刻度标签下方难以确定)。

手册“扩展ggplot2”(http://docs.ggplot2.org/dev/vignettes/extending-ggplot2.html)向您展示如何创建自己的stat函数,以便您可以直接获取数据,但问题是您始终必须定义一个几何形状与您的统计函数配合使用(即,ggplot认为您要在图中绘制此信息,而不是在边距中)。据我所知,您无法将您在自定义统计功能中计算的信息传递给像scale_x_discrete()这样的比例函数,而不在图区域内绘制任何内容。这是我尝试以这种方式实现它的方法;我能做到的最好的是将样本大小信息放置在每个组的y的最小值处:

StatN <- ggproto("StatN", Stat,
    required_aes = c("x", "y"), 
    compute_group = function(data, scales) {
    y <- data$y
    y <- y[!is.na(y)]
    n <- length(y)
    data.frame(x = data$x[1], y = min(y), label = paste0("n=", n))
    }
)

stat_n <- function(mapping = NULL, data = NULL, geom = "text", 
    position = "identity", inherit.aes = TRUE, show.legend = NA, 
        na.rm = FALSE, ...) {
    ggplot2::layer(stat = StatN, mapping = mapping, data = data, geom = geom, 
        position = position, inherit.aes = inherit.aes, show.legend = show.legend, 
        params = list(na.rm = na.rm, ...))
}

ggplot(mtcars, aes(x = factor(cyl), y = mpg)) + geom_point() + stat_n()

enter image description here

我认为通过创建一个封装函数来使用ggplot,我已经解决了这个问题:

ggstripchart <- function(data, x.name, y.name,  
    point.params = list(), 
    x.axis.params = list(labels = levels(x)), 
    y.axis.params = list(), ...) {
    if(!is.factor(data[, x.name]))
    data[, x.name] <- factor(data[, x.name])
    x <- data[, x.name]
    y <- data[, y.name]
    params <- list(...)
    point.params    <- modifyList(params, point.params)
    x.axis.params   <- modifyList(params, x.axis.params)
    y.axis.params   <- modifyList(params, y.axis.params)

    point <- do.call("geom_point", point.params)

    stripchart.list <- list(
        point, 
        theme(legend.position = "none")
    )

    n <- sapply(split(y, x), length)
    x.axis.params$labels <- paste0(x.axis.params$labels, "\nN=", n)
    x.axis <- do.call("scale_x_discrete", x.axis.params)
    y.axis <- do.call("scale_y_continuous", y.axis.params)
    stripchart.list <- c(stripchart.list, x.axis, y.axis)           

    ggplot(data = data, mapping = aes_string(x = x.name, y = y.name)) + stripchart.list
}


ggstripchart(mtcars, "cyl", "mpg")

使用ggstripchart()函数的示例

然而,该函数在分面方面无法正常工作。例如:

ggstripchart(mtcars, "cyl", "mpg") + facet_wrap(~am)

显示了每个分面组合的样本大小。我必须将分面构建到包装函数中,这违背了尝试使用ggplot所提供的一切的初衷。

使用facet_wrap的ggstripchart示例

如果有人对这个问题有任何见解,我会非常感激。非常感谢您花时间阅读!

3个回答

15

我已更新EnvStats包,加入了一个名为stat_n_textstat,它将在每个唯一的x值下方添加样本大小(唯一y值的数量)。有关stat_n_text的更多信息和示例列表,请参见帮助文件。以下是一个简单的示例:

library(ggplot2)
library(EnvStats)

p <- ggplot(mtcars, 
  aes(x = factor(cyl), y = mpg, color = factor(cyl))) + 
  theme(legend.position = "none")

p + geom_point() + 
  stat_n_text() + 
  labs(x = "Number of Cylinders", y = "Miles per Gallon")

stat_n_text演示


嗨,史蒂夫,有没有办法去掉“n =”?我只想显示数字。 - l0110

11

我的解决方案可能有点简单,但效果很好。

针对一个按照某个因素分面的例子,我首先使用paste\n创建标签。

mtcars2 <- mtcars %>% 
  group_by(cyl, am) %>% mutate(n = n()) %>% 
  mutate(label = paste0(cyl,'\nN = ',n))

我随后在ggplot代码中使用这些标签代替cyl。

ggplot(mtcars2,
   aes(x = factor(label), y = mpg, color = factor(label))) + 
  geom_point() + 
  xlab('cyl') + 
  facet_wrap(~am, scales = 'free_x') +
  theme(legend.position = "none")

制作类似下图的内容。

输入图片描述


7
如果关闭裁剪,您可以使用geom_text在x轴标签下方打印计数,但您可能需要调整位置。我在下面的代码中包含了一个“nudge”参数以进行调整。此外,下面的方法适用于所有分面(如果有)都是列分面的情况。
我知道您最终想要的是能够在新的几何图形中使用的代码,但也许下面的示例可以用于适应几何图形。
library(ggplot2)
library(dplyr)

pgg = function(dat, x, y, facet=NULL, nudge=0.17) {

  # Convert x-variable to a factor
  dat[,x] = as.factor(dat[,x])

  # Plot points
  p = ggplot(dat, aes_string(x, y)) +
    geom_point(position=position_jitter(w=0.3, h=0)) + theme_bw() 

  # Summarise data to get counts by x-variable and (if present) facet variables
  dots = lapply(c(facet, x), as.symbol)
  nn = dat %>% group_by_(.dots=dots) %>% tally

  # If there are facets, add them to the plot
  if (!is.null(facet)) {
    p = p + facet_grid(paste("~", paste(facet, collapse="+")))
  }

  # Add counts as text labels
  p = p + geom_text(data=nn, aes(label=paste0("N = ", nn$n)),
                    y=min(dat[,y]) - nudge*1.05*diff(range(dat[,y])), 
                    colour="grey20", size=3.5) +
    theme(axis.title.x=element_text(margin=unit(c(1.5,0,0,0),"lines")))

  # Turn off clipping and return plot
  p <- ggplot_gtable(ggplot_build(p))
  p$layout$clip[p$layout$name=="panel"] <- "off"
  grid.draw(p)

}

pgg(mtcars, "cyl", "mpg")
pgg(mtcars, "cyl", "mpg", facet=c("am","vs"))

另一种更灵活的选择是将计数添加到绘图面板底部。例如:

enter image description here

enter image description here

pgg = function(dat, x, y, facet_r=NULL, facet_c=NULL) {

  # Convert x-variable to a factor
  dat[,x] = as.factor(dat[,x])

  # Plot points
  p = ggplot(dat, aes_string(x, y)) +
    geom_point(position=position_jitter(w=0.3, h=0)) + theme_bw() 

  # Summarise data to get counts by x-variable and (if present) facet variables
  dots = lapply(c(facet_r, facet_c, x), as.symbol)
  nn = dat %>% group_by_(.dots=dots) %>% tally

  # If there are facets, add them to the plot
  if (!is.null(facet_r) | !is.null(facet_c)) {

    facets = paste(ifelse(is.null(facet_r),".",facet_r), " ~ " , 
                   ifelse(is.null(facet_c),".",facet_c))

    p = p + facet_grid(facets)
  }

  # Add counts as text labels
  p + geom_text(data=nn, aes(label=paste0("N = ", nn$n)),
                y=min(dat[,y]) - 0.15*min(dat[,y]), colour="grey20", size=3) +
    scale_y_continuous(limits=range(dat[,y]) + c(-0.1*min(dat[,y]), 0.01*max(dat[,y])))
}

pgg(mtcars, "cyl", "mpg")
pgg(mtcars, "cyl", "mpg", facet_c="am")
pgg(mtcars, "cyl", "mpg", facet_c="am", facet_r="vs")

enter image description here


非常感谢您的帮助!在我发布问题后,我已经想出了如何将样本大小放置在绘图面板底部,就像您的第二个建议一样。我已经几乎完成了新的统计函数和几何函数,它们将实现我的目标,并将它们合并到我的EnvStats软件包的下一个版本中(并在此处发布)。再次感谢您的帮助和建议! - Steve M

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接