内部的功能

pic*_*ick 19 r ggplot2

问题:为什么我不能sapply在里面打电话aes()

下图的目标:创建显示死亡/生活比例的直方图,以便每个组/类型组合的比例总和为1(示例受前一篇文章启发).

我知道你可以通过在外面总结来制作这个数字,ggplot但问题实际上是为什么函数不能在其中工作aes.

## Data
set.seed(999)
dat <- data.frame(group=factor(rep(1:2, 25)),
                  type=factor(sample(1:2, 50, rep=T)),
                  died=factor(sample(0:1, 50, rep=T)))

## Setup the figure
p <- ggplot(dat, aes(x=died, group=interaction(group, type), fill=group, alpha=type)) +
  theme_bw() +
  scale_alpha_discrete(range=c(0.5, 1)) +
  ylab("Proportion")

## Proportions, all groups/types together sum to 1 (not wanted)
p + geom_histogram(aes(y=..count../sum(..count..)), position=position_dodge())
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

## Look at groups
stuff <- ggplot_build(p)
stuff$data[[1]]

## The long way works: proportions by group/type
p + geom_histogram(
    aes(y=c(..count..[..group..==1] / sum(..count..[..group..==1]),
            ..count..[..group..==2] / sum(..count..[..group..==2]),
            ..count..[..group..==3] / sum(..count..[..group..==3]),
            ..count..[..group..==4] / sum(..count..[..group..==4]))),
        position='dodge'
)
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

## Why can't I call sapply there?
p + geom_histogram(
    aes(y=sapply(unique(..group..), function(g)
        ..count..[..group..==g] / sum(..count..[..group..==g]))),
        position='dodge'
)
Run Code Online (Sandbox Code Playgroud)

get中的错误(as.character(FUN),mode ="function",envir = envir):找不到模式'function'的对象'expr'

Nic*_*edy 18

因此,问题的产生是因为对ggplot2:::strip_dots包括"计算美学"在内的任何美学的递归调用.在这个问题和答案中围绕计算的美学进行了一些讨论.layer.r中的相关代码如下:

new <- strip_dots(aesthetics[is_calculated_aes(aesthetics)])
Run Code Online (Sandbox Code Playgroud)

ie strip_dots只有在使用正则表达式定义的计算美学时才被调用"\\.\\.([a-zA-z._]+)\\.\\.".

strip_dotsin采用递归方法,通过嵌套调用并剥离点.代码是这样的:

function (expr) 
{
    if (is.atomic(expr)) {
        expr
    }
    else if (is.name(expr)) {
        as.name(gsub(match_calculated_aes, "\\1", as.character(expr)))
    }
    else if (is.call(expr)) {
        expr[-1] <- lapply(expr[-1], strip_dots)
        expr
    }
    else if (is.pairlist(expr)) {
        as.pairlist(lapply(expr, expr))
    }
    else if (is.list(expr)) {
        lapply(expr, strip_dots)
    }
    else {
        stop("Unknown input:", class(expr)[1])
    }
}
Run Code Online (Sandbox Code Playgroud)

如果我们提供匿名函数,则此代码如下:

anon <- as.call(quote(function(g) mean(g)))
ggplot2:::strip_dots(anon)
Run Code Online (Sandbox Code Playgroud)

我们重现错误:

#Error in get(as.character(FUN), mode = "function", envir = envir) : 
#  object 'expr' of mode 'function' was not found
Run Code Online (Sandbox Code Playgroud)

通过这个,我们可以看到anon是一个call.对于calls,strip_dots将用于lapply调用strip_dots第二和第三个元素call.对于像这样的匿名函数,第二个元素是formals函数的元素.如果我们看formalsanon使用dput(formals(eval(anon)))dput(anon[[2]])我们看到这一点:

#pairlist(g = )
Run Code Online (Sandbox Code Playgroud)

对于pairlists,strip_dots尝试lapply自己.我不确定为什么这个代码存在,但在这种情况下肯定会导致错误:

expr <- anon[[2]]
lapply(expr, expr)

# Error in get(as.character(FUN), mode = "function", envir = envir) : 
#  object 'expr' of mode 'function' was not found
Run Code Online (Sandbox Code Playgroud)

TL; DR在此阶段,ggplot2不支持在使​​用aes计算美学(例如..count..)的地方使用匿名函数.

无论如何,可以使用以下方式实现期望的最终结果dplyr; 总的来说,我认为它使得更可读的代码将数据摘要与绘图分开:

newDat <- dat %>%
  group_by(died, type, group) %>%
  summarise(count = n()) %>%
  group_by(type, group) %>%
  mutate(Proportion = count / sum(count))

p <- ggplot(newDat, aes(x = died, y = Proportion, group = interaction(group, type), fill=group, alpha=type)) +
  theme_bw() +
  scale_alpha_discrete(range=c(0.5, 1)) +
  geom_bar(stat = "identity", position = "dodge")
Run Code Online (Sandbox Code Playgroud)

最终输出

ggplot2修复

我已经分叉了ggplot2并对aes_calculated.r做了两处修改来修复问题.第一个是纠正pairlists 的处理lapply strip_dots而不是expr,我认为一定是预期的行为.第二个是对于没有默认值的形式(如此处提供的示例),as.character(as.name(expr))抛出错误,因为它expr是一个空名称,虽然这是一个有效的构造,但是不可能从空字符串创建一个.

在分叉GGPLOT2的版本https://github.com/NikNakk/ggplot2和pull请求只是做.

最后,在所有这些之后,sapply给出的示例不起作用,因为它返回2行乘4列矩阵而不是8长度向量.更正后的版本是这样的:

p + geom_histogram(
    aes(y=unlist(lapply(unique(..group..), function(g)
        ..count..[..group..==g] / sum(..count..[..group..==g])))),
    position='dodge'
)
Run Code Online (Sandbox Code Playgroud)

这给出了与上述dplyr解决方案相同的输出.

另外需要注意的是,此lapply代码假定该阶段的数据按组排序.我认为情况总是如此,但如果出于某种原因不是这样的话,你最终会无法获得y数据.保留计算数据中行的顺序的替代方法是:

p + geom_histogram(
  aes(y={grp_total <- tapply(..count.., ..group.., sum);
  ..count.. / grp_total[as.character(..group..)]
  }),
  position='dodge'
)
Run Code Online (Sandbox Code Playgroud)

值得注意的是,这些表达式是在baseenv()基础包的命名空间中进行评估的.这意味着,从其他包的任何功能,即使是标准的像statsutils,需要与使用::操作符(如stats::rnorm).

  • 我已经修复了ggplot2源代码中的问题.在https://github.com/NikNakk/ggplot2上分叉.请求https://github.com/hadley/ggplot2/pull/1155请求.发布于https://github.com/hadley/ggplot2/issues/1154 (4认同)

jer*_*ycg 7

玩了一下后,问题似乎是使用匿名函数与..group ..或..count ..在aes内:

xy <- data.frame(x=1:10,y=1:10) #data

ggplot(xy, aes(x = x, y = sapply(y, mean))) + geom_line() #sapply is fine

ggplot(xy, aes(x = x, group = y)) + 
       geom_bar(aes(y = sapply(..group.., mean))) #sapply with ..group.. is fine

ggplot(xy, aes(x = x, group = y)) + 
       geom_bar(aes(y = sapply(..group.., function(g) {mean(g)})))
#broken, with same error

ggplot(xy, aes(x = x, group = y)) + 
    geom_bar(aes(y = sapply(y, function(g) {mean(g)})), stat = "identity")
#sapply with anonymous functions works fine!
Run Code Online (Sandbox Code Playgroud)

这似乎是一个非常奇怪的错误,除非我错过了一些愚蠢的东西.

  • 我已经进一步研究了这个问题并将其固定到`ggplot2`如何使用`strip_plots`函数处理计算的美学(如`..group..`).我曾经想过,这会对你的回答做出很好的评论,但正如你可以看到的那样,我的回答太长了!你的初步调查工作在缩小问题方面非常方便. (5认同)