使用dplyr时,使用rle按运行分组

Question

在R中,我想在基于变量的运行对数据进行分组之后对其进行汇总x(也就是说,每组数据对应于连续x值相同的数据的子集).例如,考虑以下数据框,我想计算y每次运行中的平均值x:

(dat <- data.frame(x=c(1, 1, 1, 2, 2, 1, 2), y=1:7))
#   x y
# 1 1 1
# 2 1 2
# 3 1 3
# 4 2 4
# 5 2 5
# 6 1 6
# 7 2 7

在此示例中,x变量的长度为3,然后是2,然后是1,最后是1,在这四次运行中取值1,2,1和2.y这些组中相应的手段是2,4.5,6和7.

在基础R中使用tapply,dat$y作为数据传递,使用rle从中计算运行编号dat$x,并传递所需的汇总函数,很容易执行此分组操作:

tapply(dat$y, with(rle(dat$x), rep(seq_along(lengths), lengths)), mean)
#   1   2   3   4 
# 2.0 4.5 6.0 7.0 

我想我可以直接将这个逻辑转移到dplyr,但到目前为止我的尝试都以错误结束了:

library(dplyr)
# First attempt
dat %>%
  group_by(with(rle(x), rep(seq_along(lengths), lengths))) %>%
  summarize(mean(y))
# Error: cannot coerce type 'closure' to vector of type 'integer'

# Attempt 2 -- maybe "with" is the problem?
dat %>%
  group_by(rep(seq_along(rle(x)$lengths), rle(x)$lengths)) %>%
  summarize(mean(y))
# Error: invalid subscript type 'closure'

为了完整性,我可以rle使用cumsum,重新实现run id head,并且tail绕过它,但它使得分组代码更难以阅读并涉及一些重新发明轮子:

dat %>%
  group_by(run=cumsum(c(1, head(x, -1) != tail(x, -1)))) %>%
  summarize(mean(y))
#     run mean(y)
#   (dbl)   (dbl)
# 1     1     2.0
# 2     2     4.5
# 3     3     6.0
# 4     4     7.0

是什么导致我的rle基于分组的代码失败dplyr,是否有任何解决方案使我能够rle在按运行ID分组时继续使用？

Answer 1

一种选择似乎是使用{}如下:

dat %>%
    group_by(yy = {yy = rle(x); rep(seq_along(yy$lengths), yy$lengths)}) %>%
    summarize(mean(y))
#Source: local data frame [4 x 2]
#
#     yy mean(y)
#  (int)   (dbl)
#1     1     2.0
#2     2     4.5
#3     3     6.0
#4     4     7.0

如果未来的dplyr版本也具有相当于data.table的rleid功能,那将是很好的.

我注意到在使用data.frame或tbl_df输入时出现此问题但在使用tbl_dt或data.table输入时没有:

dat %>% 
    tbl_df %>% 
    group_by(yy = with(rle(x), rep(seq_along(lengths), lengths))) %>%
    summarize(mean(y))
Error: cannot coerce type 'closure' to vector of type 'integer'

dat %>% 
    tbl_dt %>% 
    group_by(yy = with(rle(x), rep(seq_along(lengths), lengths))) %>%
    summarize(mean(y))
Source: local data table [4 x 2]

     yy mean(y)
  (int)   (dbl)
1     1     2.0
2     2     4.5
3     3     6.0
4     4     7.0

我在dplyr的github页面上报告了这个问题.