Question

我正在尝试找到循环数据框架的最有效方法，并按5组进行群集观察。例如，如果我有：

group <- c(1,2,3,4,5,6,7,8,9,10)
people <- c(1,2,3,4,4,3,2,1,2,3)
avg_age <- c(5,10,15,20,25,30,35,40,45,50)
data <- data.frame(group,people,age)

这应该生成

   group people avg_age
1      1      1   5
2      2      2  10
3      3      3  15
4      4      4  20
5      5      4  25
6      6      3  30
7      7      2  35
8      8      1  40
9      9      1  45
10    10      2  50

然后，我想制作另一组“群集”，其中至少有5个人，其中“群集”的加权平均年龄。但是我想通过遍历数据集并按顺序添加组以最有效的方式执行此操作，直到至少有5个人创建“群集”。我们的数据应该如下：

   group people age cluster tot_ppl avg_age
1      1      1   5       1       6   11.67
2      2      2  10       1       6   11.67
3      3      3  15       1       6   11.67
4      4      4  20       2       8    22.5
5      5      4  25       2       8    22.5
6      6      3  30       3       5      32
7      7      2  35       3       5      32
8      8      1  40       4       6   46.67
9      9      2  45       4       6   46.67
10    10      3  50       4       6   46.67

我想在数据集上做大约10,000次观测而不是10次这样的事情。有没有人知道有效的方法来解决这个问题？

到目前为止，这是我所得到的，对于我正在使用的一些数据样本，实际上接近200万次观测，因此运行起来可能需要一段时间......

data$cluster <- 0
count=0

while (min(data$cluster)==0)
#while (max(data$cluster)<=10)
{
count = count+1
data$cum <- ave(data$people, by=list(data$zipcode,data$cluster), FUN=cumsum) 
data$a <- floor(data$cum/10)
data$b <- data$cum-data$n1
data$c <- floor(data$b/10)
data$cluster[data$c==0] = data$cluster[data$c==0]+1
}

extravars <- c('cum','a','b','c')
for (inc.source in extravars){
  eval(parse(text = paste("data$",inc.source,"<-NULL",sep="")))         
}

data$tot_ppl <- ave(data$people, by=list(data$zipcode,data$cluster), FUN=sum) 
data$cluster[data$tot_ppl<10]=data$cluster[data$tot_ppl<10]+1
data$tot_ppl <- ave(data$people, by=list(data$zipcode,data$cluster), FUN=sum)

data2 <- data


for (i in 3:(ncol(data2)-3)){
  data2$x <- data2[ ,i]*data2$tot_ppl
  data2$x <- ave(data2$x, by=list(data2$zipcode,data2$cluster), FUN=sum)
  data2$x <- round(data2$x/data2$tot_ppl,digits=2)
  data2[ ,i] = data2$x
}

data2$x <- NULL

因此，虽然这有效，但运行需要几个小时，所以如果有人知道如何提高效率或改进它，我会非常感激。谢谢！

Answer 1

我无法想到一个聪明的方法来矢量化这个操作，所以你可以在R中使用for循环：

pureR <- function(x, lim) {
    cs <- cumsum(x)
    newGroup <- rep(FALSE, length(x))
    prevSum <- 0
    for (i in 1:length(newGroup)) {
        if (cs[i] - prevSum >= lim) {
            newGroup[i] <- TRUE
            prevSum <- cs[i]
        }
    }
    return(1+c(0, head(cumsum(newGroup), -1)))
}
pureR(dat$people, 5)
# [1] 1 1 1 2 2 3 3 4 4 4

您可以使用Rcpp包来加速非矢量化计算：

library(Rcpp)
rcpp <- cppFunction("
NumericVector rcpp(NumericVector x, const double limit) {
    NumericVector result(x.size());
    result[0] = 1;
    double acc = x[0];
    for (int i=1; i < x.size(); ++i) {
        if (acc >= limit) {
            result[i] = result[i-1] + 1;
            acc = x[i];
        } else {
            result[i] = result[i-1];
            acc += x[i];
        }
    }
    return result;
}
")
rcpp(dat$people, 5)
# [1] 1 1 1 2 2 3 3 4 4 4

最后，我们可以对具有10,000个观测值的数据集进行基准测试：

set.seed(144)
dat2 <- dat[sample(1:nrow(dat), 10000, replace=TRUE),]
library(microbenchmark)
microbenchmark(pureR(dat2$people, 5), rcpp(dat2$people, 5))
# Unit: microseconds
#                   expr      min       lq     mean   median       uq       max neval
#  pureR(dat2$people, 5) 7073.571 7287.733 8665.394 7822.639 8749.232 31313.946   100
#   rcpp(dat2$people, 5)   90.309   98.241  129.120  118.351  136.210   324.866   100

虽然Rcpp代码比纯R实现快60倍以上，但对于大小为10,000的数据集，纯R实现仍然在不到10毫秒的时间内运行，这对您来说可能很好。

循环遍历数据框中每个观察的最有效方法

1 个答案: